aboutsummaryrefslogtreecommitdiffstats
path: root/ortho/mcode/ortho_code-disps.adb
diff options
context:
space:
mode:
Diffstat (limited to 'ortho/mcode/ortho_code-disps.adb')
-rw-r--r--ortho/mcode/ortho_code-disps.adb790
1 files changed, 0 insertions, 790 deletions
diff --git a/ortho/mcode/ortho_code-disps.adb b/ortho/mcode/ortho_code-disps.adb
deleted file mode 100644
index 9e8ac1272..000000000
--- a/ortho/mcode/ortho_code-disps.adb
+++ /dev/null
@@ -1,790 +0,0 @@
--- Mcode back-end for ortho - Internal tree dumper.
--- Copyright (C) 2006 Tristan Gingold
---
--- GHDL is free software; you can redistribute it and/or modify it under
--- the terms of the GNU General Public License as published by the Free
--- Software Foundation; either version 2, or (at your option) any later
--- version.
---
--- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
--- WARRANTY; without even the implied warranty of MERCHANTABILITY or
--- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
--- for more details.
---
--- You should have received a copy of the GNU General Public License
--- along with GCC; see the file COPYING. If not, write to the Free
--- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--- 02111-1307, USA.
-with Ada.Text_IO; use Ada.Text_IO;
-with Ortho_Code.Debug;
-with Ortho_Code.Consts;
-with Ortho_Code.Decls;
-with Ortho_Code.Types;
-with Ortho_Code.Flags;
-with Ortho_Ident;
-with Interfaces;
-
-package body Ortho_Code.Disps is
- procedure Disp_Subprg (Ident : Natural; S_Entry : O_Enode);
- procedure Disp_Expr (Expr : O_Enode);
-
- procedure Disp_Indent (Indent : Natural)
- is
- begin
- Put ((1 .. 2 * Indent => ' '));
- end Disp_Indent;
-
- procedure Disp_Ident (Id : O_Ident)
- is
- use Ortho_Ident;
- begin
- Put (Get_String (Id));
- end Disp_Ident;
-
- procedure Disp_Storage (Storage : O_Storage) is
- begin
- case Storage is
- when O_Storage_External =>
- Put ("external");
- when O_Storage_Public =>
- Put ("public");
- when O_Storage_Private =>
- Put ("private");
- when O_Storage_Local =>
- Put ("local");
- end case;
- end Disp_Storage;
-
- procedure Disp_Label (Label : O_Enode)
- is
- N : Int32;
- begin
- case Get_Expr_Kind (Label) is
- when OE_Label =>
- Put ("label");
- N := Int32 (Label);
- when OE_Loop =>
- Put ("loop");
- N := Int32 (Label);
- when OE_BB =>
- Put ("BB");
- N := Get_BB_Number (Label);
- when others =>
- raise Program_Error;
- end case;
- Put (Int32'Image (N));
- Put (":");
- end Disp_Label;
-
- procedure Disp_Call (Call : O_Enode)
- is
- Arg : O_Enode;
- begin
- Decls.Disp_Decl_Name (Get_Call_Subprg (Call));
-
- Arg := Get_Arg_Link (Call);
- if Arg /= O_Enode_Null then
- Put (" (");
- loop
- Disp_Expr (Get_Expr_Operand (Arg));
- Arg := Get_Arg_Link (Arg);
- exit when Arg = O_Enode_Null;
- Put (", ");
- end loop;
- Put (")");
- end if;
- end Disp_Call;
-
- procedure Put_Trim (Str : String) is
- begin
- if Str (Str'First) = ' ' then
- Put (Str (Str'First + 1 .. Str'Last));
- else
- Put (Str);
- end if;
- end Put_Trim;
-
- procedure Disp_Typed_Lit (Lit : O_Cnode; Val : String)
- is
- use Ortho_Code.Consts;
- begin
- Disp_Type (Get_Const_Type (Lit));
- Put ("'[");
- Put_Trim (Val);
- Put (']');
- end Disp_Typed_Lit;
-
- procedure Disp_Lit (Lit : O_Cnode)
- is
- use Interfaces;
- use Ortho_Code.Consts;
- begin
- case Get_Const_Kind (Lit) is
- when OC_Unsigned =>
- Disp_Typed_Lit (Lit, Unsigned_64'Image (Get_Const_U64 (Lit)));
- when OC_Signed =>
- Disp_Typed_Lit (Lit, Integer_64'Image (Get_Const_I64 (Lit)));
- when OC_Subprg_Address =>
- Disp_Type (Get_Const_Type (Lit));
- Put ("'subprg_addr (");
- Decls.Disp_Decl_Name (Get_Const_Decl (Lit));
- Put (")");
- when OC_Address =>
- Disp_Type (Get_Const_Type (Lit));
- Put ("'address (");
- Decls.Disp_Decl_Name (Get_Const_Decl (Lit));
- Put (")");
- when OC_Sizeof =>
- Disp_Type (Get_Const_Type (Lit));
- Put ("'sizeof (");
- Disp_Type (Get_Sizeof_Type (Lit));
- Put (")");
- when OC_Null =>
- Disp_Type (Get_Const_Type (Lit));
- Put ("'[null]");
- when OC_Lit =>
- declare
- L : O_Cnode;
- begin
- L := Types.Get_Type_Enum_Lit
- (Get_Const_Type (Lit), Get_Lit_Value (Lit));
- Disp_Typed_Lit
- (Lit, Ortho_Ident.Get_String (Get_Lit_Ident (L)));
- end;
- when OC_Array =>
- Put ('{');
- for I in 1 .. Get_Const_Aggr_Length (Lit) loop
- if I /= 1 then
- Put (", ");
- end if;
- Disp_Lit (Get_Const_Aggr_Element (Lit, I - 1));
- end loop;
- Put ('}');
- when OC_Record =>
- declare
- use Ortho_Code.Types;
- F : O_Fnode;
- begin
- F := Get_Type_Record_Fields (Get_Const_Type (Lit));
- Put ('{');
- for I in 1 .. Get_Const_Aggr_Length (Lit) loop
- if I /= 1 then
- Put (", ");
- end if;
- Put ('.');
- Disp_Ident (Get_Field_Ident (F));
- Put (" = ");
- Disp_Lit (Get_Const_Aggr_Element (Lit, I - 1));
- F := Get_Field_Chain (F);
- end loop;
- Put ('}');
- end;
- when OC_Union =>
- Put ('{');
- Put ('.');
- Disp_Ident (Types.Get_Field_Ident (Get_Const_Union_Field (Lit)));
- Put ('=');
- Disp_Lit (Get_Const_Union_Value (Lit));
- Put ('}');
- when others =>
- Put ("*lit " & OC_Kind'Image (Get_Const_Kind (Lit)) & '*');
- end case;
- end Disp_Lit;
-
- procedure Disp_Expr (Expr : O_Enode)
- is
- Kind : OE_Kind;
- begin
- Kind := Get_Expr_Kind (Expr);
- case Kind is
- when OE_Const =>
- case Get_Expr_Mode (Expr) is
- when Mode_I8
- | Mode_I16
- | Mode_I32 =>
- Put_Trim (Int32'Image (To_Int32 (Get_Expr_Low (Expr))));
- when Mode_U8
- | Mode_U16
- | Mode_U32 =>
- Put_Trim (Uns32'Image (Get_Expr_Low (Expr)));
- when others =>
- Put ("const:");
- Debug.Disp_Mode (Get_Expr_Mode (Expr));
- end case;
- when OE_Lit =>
- Disp_Lit (Get_Expr_Lit (Expr));
- when OE_Case_Expr =>
- Put ("{case}");
- when OE_Kind_Dyadic
- | OE_Kind_Cmp
- | OE_Add
- | OE_Mul
- | OE_Shl =>
- Put ("(");
- Disp_Expr (Get_Expr_Left (Expr));
- Put (' ');
- case Kind is
- when OE_Eq =>
- Put ('=');
- when OE_Neq =>
- Put ("/=");
- when OE_Lt =>
- Put ("<");
- when OE_Gt =>
- Put (">");
- when OE_Ge =>
- Put (">=");
- when OE_Le =>
- Put ("<=");
- when OE_Add =>
- Put ('+');
- when OE_Mul =>
- Put ('*');
- when OE_Add_Ov =>
- Put ("+#");
- when OE_Sub_Ov =>
- Put ("-#");
- when OE_Mul_Ov =>
- Put ("*#");
- when OE_Shl =>
- Put ("<<");
- when OE_And =>
- Put ("and");
- when OE_Or =>
- Put ("or");
- when others =>
- Put (OE_Kind'Image (Kind));
- end case;
- Put (' ');
- Disp_Expr (Get_Expr_Right (Expr));
- Put (")");
- when OE_Not =>
- Put ("not ");
- Disp_Expr (Get_Expr_Operand (Expr));
- when OE_Neg_Ov =>
- Put ("neg ");
- Disp_Expr (Get_Expr_Operand (Expr));
- when OE_Abs_Ov =>
- Put ("abs ");
- Disp_Expr (Get_Expr_Operand (Expr));
- when OE_Indir =>
- declare
- Op : O_Enode;
- begin
- Op := Get_Expr_Operand (Expr);
- case Get_Expr_Kind (Op) is
- when OE_Addrg
- | OE_Addrl =>
- Decls.Disp_Decl_Name (Get_Addr_Object (Op));
- when others =>
- --Put ("*");
- Disp_Expr (Op);
- end case;
- end;
- when OE_Addrl
- | OE_Addrg =>
- -- Put ('@');
- Decls.Disp_Decl_Name (Get_Addr_Object (Expr));
- when OE_Call =>
- Disp_Call (Expr);
- when OE_Alloca =>
- Put ("alloca (");
- Disp_Expr (Get_Expr_Operand (Expr));
- Put (")");
- when OE_Conv =>
- Disp_Type (Get_Conv_Type (Expr));
- Put ("'conv (");
- Disp_Expr (Get_Expr_Operand (Expr));
- Put (")");
- when OE_Conv_Ptr =>
- Disp_Type (Get_Conv_Type (Expr));
- Put ("'address (");
- Disp_Expr (Get_Expr_Operand (Expr));
- Put (")");
- when OE_Typed =>
- Disp_Type (Get_Conv_Type (Expr));
- Put ("'");
- -- Note: there is always parenthesis around comparison.
- Disp_Expr (Get_Expr_Operand (Expr));
- when OE_Record_Ref =>
- Disp_Expr (Get_Expr_Operand (Expr));
- Put (".");
- Disp_Ident (Types.Get_Field_Ident (Get_Ref_Field (Expr)));
- when OE_Access_Ref =>
- Disp_Expr (Get_Expr_Operand (Expr));
- Put (".all");
- when OE_Index_Ref =>
- Disp_Expr (Get_Expr_Operand (Expr));
- Put ('[');
- Disp_Expr (Get_Ref_Index (Expr));
- Put (']');
- when OE_Slice_Ref =>
- Disp_Expr (Get_Expr_Operand (Expr));
- Put ('[');
- Disp_Expr (Get_Ref_Index (Expr));
- Put ("...]");
- when OE_Get_Stack =>
- Put ("%sp");
- when OE_Get_Frame =>
- Put ("%fp");
- when others =>
- Put_Line (Standard_Error, "disps.disp_expr: unknown expr "
- & OE_Kind'Image (Kind));
- end case;
- end Disp_Expr;
-
- procedure Disp_Fields (Indent : Natural; Atype : O_Tnode)
- is
- use Types;
- Nbr : Uns32;
- F : O_Fnode;
- begin
- Nbr := Get_Type_Record_Nbr_Fields (Atype);
- F := Get_Type_Record_Fields (Atype);
- for I in 1 .. Nbr loop
- Disp_Indent (Indent);
- Disp_Ident (Get_Field_Ident (F));
- Put (": ");
- Disp_Type (Get_Field_Type (F));
- Put (";");
- New_Line;
- F := Get_Field_Chain (F);
- end loop;
- end Disp_Fields;
-
- procedure Disp_Type (Atype : O_Tnode; Force : Boolean := False)
- is
- use Types;
- Kind : OT_Kind;
- Decl : O_Dnode;
- begin
- if not Force then
- Decl := Decls.Get_Type_Decl (Atype);
- if Decl /= O_Dnode_Null then
- Decls.Disp_Decl_Name (Decl);
- return;
- end if;
- end if;
-
- Kind := Get_Type_Kind (Atype);
- case Kind is
- when OT_Signed =>
- Put ("signed (");
- Put_Trim (Uns32'Image (8 * Get_Type_Size (Atype)));
- Put (")");
- when OT_Unsigned =>
- Put ("unsigned (");
- Put_Trim (Uns32'Image (8 * Get_Type_Size (Atype)));
- Put (")");
- when OT_Float =>
- Put ("float");
- when OT_Access =>
- Put ("access");
- declare
- Acc_Type : O_Tnode;
- begin
- Acc_Type := Get_Type_Access_Type (Atype);
- if Acc_Type /= O_Tnode_Null then
- Put (' ');
- Disp_Type (Acc_Type);
- end if;
- end;
- when OT_Ucarray =>
- Put ("array [");
- Disp_Type (Get_Type_Ucarray_Index (Atype));
- Put ("] of ");
- Disp_Type (Get_Type_Ucarray_Element (Atype));
- when OT_Subarray =>
- Put ("subarray ");
- Disp_Type (Get_Type_Subarray_Base (Atype));
- Put ("[");
- Put_Trim (Uns32'Image (Get_Type_Subarray_Length (Atype)));
- Put ("]");
- when OT_Record =>
- Put_Line ("record");
- Disp_Fields (1, Atype);
- Put ("end record");
- when OT_Union =>
- Put_Line ("union");
- Disp_Fields (1, Atype);
- Put ("end union");
- when OT_Boolean =>
- declare
- Lit : O_Cnode;
- begin
- Put ("boolean {");
- Lit := Get_Type_Bool_False (Atype);
- Disp_Ident (Consts.Get_Lit_Ident (Lit));
- Put (", ");
- Lit := Get_Type_Bool_True (Atype);
- Disp_Ident (Consts.Get_Lit_Ident (Lit));
- Put ("}");
- end;
- when OT_Enum =>
- declare
- use Consts;
- Lit : O_Cnode;
- begin
- Put ("enum {");
- Lit := Get_Type_Enum_Lits (Atype);
- for I in 1 .. Get_Type_Enum_Nbr_Lits (Atype) loop
- if I /= 1 then
- Put (", ");
- end if;
- Disp_Ident (Get_Lit_Ident (Lit));
- Put (" =");
- Put (Uns32'Image (I - 1));
- Lit := Get_Lit_Chain (Lit);
- end loop;
- Put ('}');
- end;
- when OT_Complete =>
- Put ("-- complete: ");
- Disp_Type (Get_Type_Complete_Type (Atype));
- end case;
- end Disp_Type;
-
- procedure Disp_Decl_Storage (Decl : O_Dnode) is
- begin
- Disp_Storage (Decls.Get_Decl_Storage (Decl));
- Put (' ');
- end Disp_Decl_Storage;
-
- procedure Disp_Subprg_Decl (Indent : Natural; Decl : O_Dnode)
- is
- use Decls;
- Kind : OD_Kind;
- Inter : O_Dnode;
- begin
- Disp_Decl_Storage (Decl);
- Kind := Get_Decl_Kind (Decl);
- case Kind is
- when OD_Function =>
- Put ("function ");
- when OD_Procedure =>
- Put ("procedure ");
- when others =>
- raise Program_Error;
- end case;
-
- Disp_Decl_Name (Decl);
- Inter := Get_Subprg_Interfaces (Decl);
- Put (" (");
- New_Line;
- if Inter /= O_Dnode_Null then
- loop
- Disp_Indent (Indent + 1);
- Disp_Decl_Name (Inter);
- Put (": ");
- Disp_Type (Get_Decl_Type (Inter));
- Inter := Get_Interface_Chain (Inter);
- exit when Inter = O_Dnode_Null;
- Put (";");
- New_Line;
- end loop;
- else
- Disp_Indent (Indent + 1);
- end if;
- Put (")");
- if Kind = OD_Function then
- New_Line;
- Disp_Indent (Indent + 1);
- Put ("return ");
- Disp_Type (Get_Decl_Type (Decl));
- end if;
- end Disp_Subprg_Decl;
-
- procedure Disp_Decl (Indent : Natural;
- Decl : O_Dnode;
- Nl : Boolean := False)
- is
- use Decls;
- Kind : OD_Kind;
- Dtype : O_Tnode;
- begin
- Kind := Get_Decl_Kind (Decl);
- if Kind = OD_Interface then
- return;
- end if;
- Disp_Indent (Indent);
- case Kind is
- when OD_Type =>
- Dtype := Get_Decl_Type (Decl);
- Put ("type ");
- Disp_Decl_Name (Decl);
- Put (" is ");
- Disp_Type (Dtype, True);
- Put_Line (";");
- when OD_Local
- | OD_Var =>
- Disp_Decl_Storage (Decl);
- Put ("var ");
- Disp_Decl_Name (Decl);
- Put (" : ");
- Dtype := Get_Decl_Type (Decl);
- Disp_Type (Dtype);
- if True then
- Put (" {size="
- & Uns32'Image (Types.Get_Type_Size (Dtype)) & "}");
- end if;
- Put_Line (";");
- when OD_Const =>
- Disp_Decl_Storage (Decl);
- Put ("constant ");
- Disp_Decl_Name (Decl);
- Put (" : ");
- Disp_Type (Get_Decl_Type (Decl));
- Put_Line (";");
- when OD_Const_Val =>
- Put ("constant ");
- Disp_Decl_Name (Get_Val_Decl (Decl));
- Put (" := ");
- Disp_Lit (Get_Val_Val (Decl));
- Put_Line (";");
- when OD_Function
- | OD_Procedure =>
- Disp_Subprg_Decl (Indent, Decl);
- Put_Line (";");
- when OD_Interface =>
- null;
- when OD_Body =>
- -- Put ("body ");
- Disp_Subprg_Decl (Indent, Get_Body_Decl (Decl));
- -- Disp_Decl_Name (Get_Body_Decl (Decl));
- New_Line;
- Disp_Subprg (Indent, Get_Body_Stmt (Decl));
- when OD_Block | OD_Subprg_Ext =>
- null;
- end case;
- if Nl then
- New_Line;
- end if;
- end Disp_Decl;
-
- procedure Disp_Stmt (Indent : in out Natural; Stmt : O_Enode)
- is
- use Decls;
- Expr : O_Enode;
- begin
- case Get_Expr_Kind (Stmt) is
- when OE_Beg =>
- Disp_Indent (Indent);
- Put_Line ("declare");
- declare
- Last : O_Dnode;
- Decl : O_Dnode;
- begin
- Decl := Get_Block_Decls (Stmt);
- Last := Get_Block_Last (Decl);
- Decl := Decl + 1;
- while Decl <= Last loop
- case Get_Decl_Kind (Decl) is
- when OD_Block =>
- Decl := Get_Block_Last (Decl) + 1;
- when others =>
- Disp_Decl (Indent + 1, Decl, False);
- Decl := Decl + 1;
- end case;
- end loop;
- end;
- Disp_Indent (Indent);
- Put_Line ("begin");
- Indent := Indent + 1;
- when OE_End =>
- Indent := Indent - 1;
- Disp_Indent (Indent);
- Put_Line ("end;");
- when OE_Line =>
- Disp_Indent (Indent);
- Put_Line ("--#" & Int32'Image (Get_Expr_Line_Number (Stmt)));
- when OE_BB =>
- Disp_Indent (Indent);
- Put_Line ("# BB" & Int32'Image (Get_BB_Number (Stmt)));
- when OE_Asgn =>
- Disp_Indent (Indent);
- Disp_Expr (Get_Assign_Target (Stmt));
- Put (" := ");
- Disp_Expr (Get_Expr_Operand (Stmt));
- Put_Line (";");
- when OE_Call =>
- Disp_Indent (Indent);
- Disp_Call (Stmt);
- Put_Line (";");
- when OE_Jump_F =>
- Disp_Indent (Indent);
- Put ("jump ");
- Disp_Label (Get_Jump_Label (Stmt));
- Put (" if not ");
- Disp_Expr (Get_Expr_Operand (Stmt));
- New_Line;
- when OE_Jump_T =>
- Disp_Indent (Indent);
- Put ("jump ");
- Disp_Label (Get_Jump_Label (Stmt));
- Put (" if ");
- Disp_Expr (Get_Expr_Operand (Stmt));
- New_Line;
- when OE_Jump =>
- Disp_Indent (Indent);
- Put ("jump ");
- Disp_Label (Get_Jump_Label (Stmt));
- New_Line;
- when OE_Label =>
- Disp_Indent (Indent);
- Disp_Label (Stmt);
- New_Line;
- when OE_Ret =>
- Disp_Indent (Indent);
- Put ("return");
- Expr := Get_Expr_Operand (Stmt);
- if Expr /= O_Enode_Null then
- Put (" ");
- Disp_Expr (Expr);
- end if;
- Put_Line (";");
- when OE_Set_Stack =>
- Disp_Indent (Indent);
- Put ("%sp := ");
- Disp_Expr (Get_Expr_Operand (Stmt));
- Put_Line (";");
- when OE_Leave =>
- Disp_Indent (Indent);
- Put_Line ("# leave");
- when OE_If =>
- Disp_Indent (Indent);
- Put ("if ");
- Disp_Expr (Get_Expr_Operand (Stmt));
- Put (" then");
- New_Line;
- Indent := Indent + 1;
- when OE_Else =>
- Disp_Indent (Indent - 1);
- Put ("else");
- New_Line;
- when OE_Endif =>
- Indent := Indent - 1;
- Disp_Indent (Indent);
- Put_Line ("end if;");
- when OE_Loop =>
- Disp_Indent (Indent);
- Disp_Label (Stmt);
- New_Line;
- Indent := Indent + 1;
- when OE_Exit =>
- Disp_Indent (Indent);
- Put ("exit ");
- Disp_Label (Get_Jump_Label (Stmt));
- Put (";");
- New_Line;
- when OE_Next =>
- Disp_Indent (Indent);
- Put ("next ");
- Disp_Label (Get_Jump_Label (Stmt));
- Put (";");
- New_Line;
- when OE_Eloop =>
- Indent := Indent - 1;
- Disp_Indent (Indent);
- Put_Line ("end loop;");
- when OE_Case =>
- Disp_Indent (Indent);
- Put ("case ");
- Disp_Expr (Get_Expr_Operand (Stmt));
- Put (" is");
- New_Line;
- if Debug.Flag_Debug_Hli then
- Indent := Indent + 2;
- end if;
- when OE_Case_Branch =>
- Disp_Indent (Indent - 1);
- Put ("when ");
- declare
- C : O_Enode;
- L, H : O_Enode;
- begin
- C := Get_Case_Branch_Choice (Stmt);
- loop
- L := Get_Expr_Left (C);
- H := Get_Expr_Right (C);
- if L = O_Enode_Null then
- Put ("others");
- else
- Disp_Expr (L);
- if H /= O_Enode_Null then
- Put (" ... ");
- Disp_Expr (H);
- end if;
- end if;
- C := Get_Case_Choice_Link (C);
- exit when C = O_Enode_Null;
- New_Line;
- Disp_Indent (Indent - 1);
- Put (" | ");
- end loop;
- Put (" =>");
- New_Line;
- end;
- when OE_Case_End =>
- Indent := Indent - 2;
- Disp_Indent (Indent);
- Put ("end case;");
- New_Line;
- when others =>
- Put_Line (Standard_Error, "debug.disp_stmt: unknown statement " &
- OE_Kind'Image (Get_Expr_Kind (Stmt)));
- end case;
- end Disp_Stmt;
-
- procedure Disp_Subprg (Ident : Natural; S_Entry : O_Enode)
- is
- Stmt : O_Enode;
- N_Ident : Natural := Ident;
- begin
- Stmt := S_Entry;
- loop
- Stmt := Get_Stmt_Link (Stmt);
- Disp_Stmt (N_Ident, Stmt);
- exit when Get_Expr_Kind (Stmt) = OE_Leave;
- end loop;
- end Disp_Subprg;
-
- Last_Decl : O_Dnode := O_Dnode_First;
-
- procedure Disp_Decls_Until (Last : O_Dnode; Nl : Boolean := False) is
- begin
- while Last_Decl <= Last loop
- Disp_Decl (0, Last_Decl, Nl);
- Last_Decl := Last_Decl + 1;
- end loop;
- end Disp_Decls_Until;
-
- procedure Disp_Subprg (Subprg : Subprogram_Data_Acc)
- is
- use Decls;
- begin
- Disp_Decls_Until (Subprg.D_Body, True);
- if Get_Decl_Kind (Last_Decl) /= OD_Block then
- raise Program_Error;
- end if;
- if Debug.Flag_Debug_Keep then
- -- If nodes are kept, the next declaration to be displayed (at top
- -- level) is the one that follow the subprogram block.
- Last_Decl := Get_Block_Last (Last_Decl) + 1;
- else
- -- If nodes are not kept, this subprogram block will be freed, and
- -- the next declaration is the block itself.
- Last_Decl := Subprg.D_Body;
- end if;
- end Disp_Subprg;
-
- procedure Init is
- begin
- Flags.Flag_Type_Name := True;
- end Init;
-
- procedure Finish is
- begin
- Disp_Decls_Until (Decls.Get_Decl_Last, True);
- end Finish;
-
-end Ortho_Code.Disps;
generated by cgit v1.2.3 (git 2.25.1) at 2025-04-06 09:52:54 +0000