diff options
23 files changed, 153 insertions, 158 deletions
diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb index bcca8dbd1..145a4c5e9 100644 --- a/src/ortho/debug/ortho_debug-disp.adb +++ b/src/ortho/debug/ortho_debug-disp.adb @@ -885,7 +885,7 @@ package body Ortho_Debug.Disp is Put (" : "); Disp_Tnode_Name (Decl.Dtype); Put_Line (";"); - when ON_Const_Value => + when ON_Init_Value => Put_Keyword ("constant"); Put (" "); Disp_Ident (Decl.Name); diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb index 00bfcbc5c..218fd9671 100644 --- a/src/ortho/debug/ortho_debug.adb +++ b/src/ortho/debug/ortho_debug.adb @@ -1265,58 +1265,57 @@ package body Ortho_Debug is Storage => Storage, Scope => Current_Decl_Scope.Parent, Lineno => 0, - Const_Value => O_Dnode_Null); + Value_Decl => O_Dnode_Null); Add_Decl (Res); end New_Const_Decl; - procedure Start_Const_Value (Const : in out O_Dnode) + procedure Start_Init_Value (Decl : in out O_Dnode) is - subtype O_Dnode_Const_Value is O_Dnode_Type (ON_Const_Value); + subtype O_Dnode_Init_Value is O_Dnode_Type (ON_Init_Value); N : O_Dnode; begin - if Const.Const_Value /= O_Dnode_Null then + if Decl.Value_Decl /= O_Dnode_Null then -- Constant already has a value. raise Syntax_Error; end if; - if Const.Storage = O_Storage_External then - -- An external constant must not have a value. + if Decl.Storage = O_Storage_External then + -- An external variable/constant cannot have a value. raise Syntax_Error; end if; -- FIXME: check scope is the same. - N := new O_Dnode_Const_Value'(Kind => ON_Const_Value, - Name => Const.Name, - Next => null, - Dtype => Const.Dtype, - Storage => Const.Storage, - Scope => Current_Decl_Scope.Parent, - Lineno => 0, - Const_Decl => Const, - Value => O_Cnode_Null); - Const.Const_Value := N; + N := new O_Dnode_Init_Value'(Kind => ON_Init_Value, + Name => Decl.Name, + Next => null, + Dtype => Decl.Dtype, + Storage => Decl.Storage, + Scope => Current_Decl_Scope.Parent, + Lineno => 0, + Init_Decl => Decl, + Value => O_Cnode_Null); + Decl.Value_Decl := N; Add_Decl (N, False); - end Start_Const_Value; + end Start_Init_Value; - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) - is + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode) is begin - if Const.Const_Value = O_Dnode_Null then - -- Start_Const_Value not called. + if Decl.Value_Decl = O_Dnode_Null then + -- Start_Init_Value not called. raise Syntax_Error; end if; - if Const.Const_Value.Value /= O_Cnode_Null then - -- Finish_Const_Value already called. + if Decl.Value_Decl.Value /= O_Cnode_Null then + -- Finish_Init_Value already called. raise Syntax_Error; end if; if Val = O_Cnode_Null then -- No value or bad type. raise Type_Error; end if; - Check_Type (Val.Ctype, Const.Dtype); - Const.Const_Value.Value := Val; - end Finish_Const_Value; + Check_Type (Val.Ctype, Decl.Dtype); + Decl.Value_Decl.Value := Val; + end Finish_Init_Value; procedure New_Var_Decl (Res : out O_Dnode; @@ -1334,7 +1333,8 @@ package body Ortho_Debug is Dtype => Atype, Storage => Storage, Lineno => 0, - Scope => Current_Decl_Scope.Parent); + Scope => Current_Decl_Scope.Parent, + Value_Decl => O_Dnode_Null); Add_Decl (Res); end New_Var_Decl; diff --git a/src/ortho/debug/ortho_debug.private.ads b/src/ortho/debug/ortho_debug.private.ads index 2a733526c..7a050321a 100644 --- a/src/ortho/debug/ortho_debug.private.ads +++ b/src/ortho/debug/ortho_debug.private.ads @@ -48,7 +48,7 @@ private (ON_Type_Decl, ON_Completed_Type_Decl, ON_Const_Decl, ON_Var_Decl, ON_Interface_Decl, ON_Function_Decl, ON_Function_Body, - ON_Const_Value, + ON_Init_Value, ON_Debug_Line_Decl, ON_Debug_Comment_Decl, ON_Debug_Filename_Decl); type O_Dnode_Type (<>); @@ -70,13 +70,14 @@ private null; when ON_Completed_Type_Decl => null; - when ON_Const_Decl => - Const_Value : O_Dnode; - when ON_Const_Value => - Const_Decl : O_Dnode; + when ON_Const_Decl + | ON_Var_Decl => + -- Corresponding declaration for initial value (if any). + Value_Decl : O_Dnode; + when ON_Init_Value => + -- Corresponding declaration of the object. + Init_Decl : O_Dnode; Value : O_Cnode; - when ON_Var_Decl => - null; when ON_Function_Decl => Interfaces : O_Dnode; Func_Body : O_Dnode; diff --git a/src/ortho/gcc/ortho-lang.c b/src/ortho/gcc/ortho-lang.c index 0c38fbfce..b4fdbe388 100644 --- a/src/ortho/gcc/ortho-lang.c +++ b/src/ortho/gcc/ortho-lang.c @@ -1623,17 +1623,17 @@ new_const_decl (tree *res, tree ident, enum o_storage storage, tree atype) } void -start_const_value (tree *cst ATTRIBUTE_UNUSED) +start_init_value (tree *decl ATTRIBUTE_UNUSED) { } void -finish_const_value (tree *cst, tree val) +finish_init_value (tree *decl, tree val) { - DECL_INITIAL (*cst) = val; + DECL_INITIAL (*decl) = val; TREE_CONSTANT (val) = 1; - TREE_STATIC (*cst) = 1; - rest_of_decl_compilation (*cst, current_function_decl == NULL_TREE, 0); + TREE_STATIC (*decl) = 1; + rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0); } void diff --git a/src/ortho/gcc/ortho_gcc.ads b/src/ortho/gcc/ortho_gcc.ads index 6f43be4cb..ab7e0e3d0 100644 --- a/src/ortho/gcc/ortho_gcc.ads +++ b/src/ortho/gcc/ortho_gcc.ads @@ -350,9 +350,9 @@ package Ortho_Gcc is Storage : O_Storage; Atype : O_Tnode); - -- Set the value of a non-external constant. - procedure Start_Const_Value (Const : in out O_Dnode); - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode); + -- Set the value of a non-external constant or variable. + procedure Start_Init_Value (Decl : in out O_Dnode); + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode); -- Create a variable declaration. -- A variable can be local only inside a function. @@ -657,8 +657,8 @@ private pragma Import (C, New_Const_Decl); pragma Import (C, New_Var_Decl); - pragma Import (C, Start_Const_Value); - pragma Import (C, Finish_Const_Value); + pragma Import (C, Start_Init_Value); + pragma Import (C, Finish_Init_Value); pragma Import (C, Start_Function_Decl); pragma Import (C, Start_Procedure_Decl); diff --git a/src/ortho/gcc/ortho_gcc.private.ads b/src/ortho/gcc/ortho_gcc.private.ads index 7eacdf48e..615c8aa13 100644 --- a/src/ortho/gcc/ortho_gcc.private.ads +++ b/src/ortho/gcc/ortho_gcc.private.ads @@ -225,8 +225,8 @@ private pragma Import (C, New_Const_Decl); pragma Import (C, New_Var_Decl); - pragma Import (C, Start_Const_Value); - pragma Import (C, Finish_Const_Value); + pragma Import (C, Start_Init_Value); + pragma Import (C, Finish_Init_Value); pragma Import (C, Start_Function_Decl); pragma Import (C, Start_Procedure_Decl); diff --git a/src/ortho/llvm/ortho_llvm.adb b/src/ortho/llvm/ortho_llvm.adb index f6e3dbefc..8106f9d7d 100644 --- a/src/ortho/llvm/ortho_llvm.adb +++ b/src/ortho/llvm/ortho_llvm.adb @@ -2021,22 +2021,22 @@ package body Ortho_LLVM is end New_Const_Decl; ----------------------- - -- Start_Const_Value -- + -- Start_Init_Value -- ----------------------- - procedure Start_Const_Value (Const : in out O_Dnode) is + procedure Start_Init_Value (Decl : in out O_Dnode) is begin null; - end Start_Const_Value; + end Start_Init_Value; ------------------------ - -- Finish_Const_Value -- + -- Finish_Init_Value -- ------------------------ - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) is + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode) is begin - SetInitializer (Const.LLVM, Val.LLVM); - end Finish_Const_Value; + SetInitializer (Decl.LLVM, Val.LLVM); + end Finish_Init_Value; ------------------ -- New_Var_Decl -- diff --git a/src/ortho/llvm/ortho_llvm.ads b/src/ortho/llvm/ortho_llvm.ads index 4cd0feba2..3f77a86b9 100644 --- a/src/ortho/llvm/ortho_llvm.ads +++ b/src/ortho/llvm/ortho_llvm.ads @@ -373,9 +373,9 @@ package Ortho_LLVM is Storage : O_Storage; Atype : O_Tnode); - -- Set the value of a non-external constant. - procedure Start_Const_Value (Const : in out O_Dnode); - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode); + -- Set the value of a non-external constant or variable. + procedure Start_Init_Value (Decl : in out O_Dnode); + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode); -- Create a variable declaration. -- A variable can be local only inside a function. diff --git a/src/ortho/mcode/ortho_code-decls.adb b/src/ortho/mcode/ortho_code-decls.adb index b95d4a2b8..a3a5e5eb0 100644 --- a/src/ortho/mcode/ortho_code-decls.adb +++ b/src/ortho/mcode/ortho_code-decls.adb @@ -345,6 +345,8 @@ package body Ortho_Code.Decls is procedure New_Init_Value (Decl : O_Dnode; Val : O_Cnode) is begin + pragma Assert (Get_Decl_Kind (Decl) = OD_Const + or else Get_Decl_Kind (Decl) = OD_Var); if Get_Init_Value (Decl) /= O_Cnode_Null then -- Value was already set. raise Syntax_Error; @@ -363,18 +365,10 @@ package body Ortho_Code.Decls is end if; end New_Init_Value; - procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode) is - begin - pragma Assert (Get_Decl_Kind (Cst) = OD_Const); - New_Init_Value (Cst, Val); - end New_Const_Value; - - procedure New_Var_Decl - (Res : out O_Dnode; - Ident : O_Ident; - Storage : O_Storage; - Atype : O_Tnode) - is + procedure New_Var_Decl (Res : out O_Dnode; + Ident : O_Ident; + Storage : O_Storage; + Atype : O_Tnode) is begin if Storage = O_Storage_Local then Dnodes.Append (Dnode_Common'(Kind => OD_Local, diff --git a/src/ortho/mcode/ortho_code-decls.ads b/src/ortho/mcode/ortho_code-decls.ads index 0cd532593..70a0ba4df 100644 --- a/src/ortho/mcode/ortho_code-decls.ads +++ b/src/ortho/mcode/ortho_code-decls.ads @@ -132,8 +132,8 @@ package Ortho_Code.Decls is Storage : O_Storage; Atype : O_Tnode); - -- Set the value to CST. - procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode); + -- Set the value to DECL. + procedure New_Init_Value (Decl : O_Dnode; Val : O_Cnode); -- Create a variable declaration. -- A variable can be local only inside a function. diff --git a/src/ortho/mcode/ortho_mcode.adb b/src/ortho/mcode/ortho_mcode.adb index 77e101721..cb2ab6663 100644 --- a/src/ortho/mcode/ortho_mcode.adb +++ b/src/ortho/mcode/ortho_mcode.adb @@ -29,12 +29,12 @@ package body Ortho_Mcode is null; end New_Debug_Comment_Stmt; - procedure Start_Const_Value (Const : in out O_Dnode) + procedure Start_Init_Value (Decl : in out O_Dnode) is - pragma Unreferenced (Const); + pragma Unreferenced (Decl); begin null; - end Start_Const_Value; + end Start_Init_Value; procedure Start_Record_Type (Elements : out O_Element_List) is begin @@ -112,12 +112,12 @@ package body Ortho_Mcode is Ortho_Code.O_Tnode (Dtype)); end Finish_Access_Type; - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode) + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode) is - pragma Warnings (Off, Const); + pragma Warnings (Off, Decl); begin - New_Const_Value (Ortho_Code.O_Dnode (Const), Ortho_Code.O_Cnode (Val)); - end Finish_Const_Value; + New_Init_Value (Ortho_Code.O_Dnode (Decl), Ortho_Code.O_Cnode (Val)); + end Finish_Init_Value; function New_Array_Type (El_Type : O_Tnode; Index_Type : O_Tnode) return O_Tnode is diff --git a/src/ortho/mcode/ortho_mcode.ads b/src/ortho/mcode/ortho_mcode.ads index 45e803690..ec65fab5c 100644 --- a/src/ortho/mcode/ortho_mcode.ads +++ b/src/ortho/mcode/ortho_mcode.ads @@ -297,8 +297,8 @@ package Ortho_Mcode is function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode) return O_Lnode; - -- Get an element of a record. - -- Type of REC must be a record type. + -- Get an element of a record or a union. + -- Type of REC must be a record or a union type. function New_Selected_Element (Rec : O_Lnode; El : O_Fnode) return O_Lnode; @@ -357,9 +357,9 @@ package Ortho_Mcode is Storage : O_Storage; Atype : O_Tnode); - -- Set the value of a non-external constant. - procedure Start_Const_Value (Const : in out O_Dnode); - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode); + -- Set the value of a non-external constant or variable. + procedure Start_Init_Value (Decl : in out O_Dnode); + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode); -- Create a variable declaration. -- A variable can be local only inside a function. @@ -538,8 +538,8 @@ private pragma Inline (New_Type_Decl); pragma Inline (New_Const_Decl); - pragma Inline (Start_Const_Value); - pragma Inline (Finish_Const_Value); + pragma Inline (Start_Init_Value); + pragma Inline (Finish_Init_Value); pragma Inline (New_Var_Decl); pragma Inline (New_Obj); diff --git a/src/ortho/mcode/ortho_mcode.private.ads b/src/ortho/mcode/ortho_mcode.private.ads index 1b414773f..5374ae978 100644 --- a/src/ortho/mcode/ortho_mcode.private.ads +++ b/src/ortho/mcode/ortho_mcode.private.ads @@ -106,8 +106,8 @@ private pragma Inline (New_Type_Decl); pragma Inline (New_Const_Decl); - pragma Inline (Start_Const_Value); - pragma Inline (Finish_Const_Value); + pragma Inline (Start_Init_Value); + pragma Inline (Finish_Init_Value); pragma Inline (New_Var_Decl); pragma Inline (New_Obj); diff --git a/src/ortho/oread/ortho_front.adb b/src/ortho/oread/ortho_front.adb index cd01eb368..6ba026221 100644 --- a/src/ortho/oread/ortho_front.adb +++ b/src/ortho/oread/ortho_front.adb @@ -2500,9 +2500,9 @@ package body Ortho_Front is N.Decl_Defined := True; Next_Token; - Start_Const_Value (N.Obj_Node); + Start_Init_Value (N.Obj_Node); Val := Parse_Constant_Value (N.Decl_Dtype); - Finish_Const_Value (N.Obj_Node, Val); + Finish_Init_Value (N.Obj_Node, Val); end if; end Parse_Constant_Declaration; @@ -2528,9 +2528,9 @@ package body Ortho_Front is -- should check the object has no value. Next_Expect (Tok_Assign); Next_Token; - Start_Const_Value (N.Obj_Node); + Start_Init_Value (N.Obj_Node); Val := Parse_Constant_Value (N.Decl_Dtype); - Finish_Const_Value (N.Obj_Node, Val); + Finish_Init_Value (N.Obj_Node, Val); end Parse_Constant_Value_Declaration; procedure Parse_Var_Declaration (Storage : O_Storage) diff --git a/src/ortho/ortho_nodes.common.ads b/src/ortho/ortho_nodes.common.ads index f9caf32a7..a40323656 100644 --- a/src/ortho/ortho_nodes.common.ads +++ b/src/ortho/ortho_nodes.common.ads @@ -344,9 +344,9 @@ package ORTHO_NODES is Storage : O_Storage; Atype : O_Tnode); - -- Set the value of a non-external constant. - procedure Start_Const_Value (Const : in out O_Dnode); - procedure Finish_Const_Value (Const : in out O_Dnode; Val : O_Cnode); + -- Set the value of a non-external constant or variable. + procedure Start_Init_Value (Decl : in out O_Dnode); + procedure Finish_Init_Value (Decl : in out O_Dnode; Val : O_Cnode); -- Create a variable declaration. -- A variable can be local only inside a function. diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index a3c8233f0..3e4400071 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -232,8 +232,8 @@ package body Trans.Chap1 is (Info.Block_Instance_Size, Create_Identifier ("INSTSIZE"), Global_Storage, Ghdl_Index_Type); if Global_Storage /= O_Storage_External then - Start_Const_Value (Info.Block_Instance_Size); - Finish_Const_Value + Start_Init_Value (Info.Block_Instance_Size); + Finish_Init_Value (Info.Block_Instance_Size, Get_Scope_Size (Info.Block_Scope)); end if; diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index 4786ffbbc..185a01e8f 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -207,8 +207,8 @@ package body Trans.Chap12 is New_Const_Decl (Const, Create_Identifier ("INSTSIZE"), O_Storage_Public, Ghdl_Index_Type); - Start_Const_Value (Const); - Finish_Const_Value (Const, Get_Scope_Size (Arch_Info.Block_Scope)); + Start_Init_Value (Const); + Finish_Init_Value (Const, Get_Scope_Size (Arch_Info.Block_Scope)); -- Elaborator. Start_Procedure_Decl @@ -306,8 +306,8 @@ package body Trans.Chap12 is New_Const_Decl (Const, Create_Identifier ("INSTSIZE"), O_Storage_Public, Ghdl_Index_Type); - Start_Const_Value (Const); - Finish_Const_Value (Const, Ghdl_Index_0); + Start_Init_Value (Const); + Finish_Init_Value (Const, Ghdl_Index_0); -- Elaborator. Start_Procedure_Decl diff --git a/src/vhdl/translate/trans-chap14.adb b/src/vhdl/translate/trans-chap14.adb index eacbf759b..3072b5955 100644 --- a/src/vhdl/translate/trans-chap14.adb +++ b/src/vhdl/translate/trans-chap14.adb @@ -912,8 +912,8 @@ package body Trans.Chap14 is Str_Cst := Create_String_Len (Name.Suffix, Create_Uniq_Identifier); New_Const_Decl (Name_Cst, Create_Uniq_Identifier, O_Storage_Private, Ghdl_Str_Len_Type_Node); - Start_Const_Value (Name_Cst); - Finish_Const_Value (Name_Cst, Str_Cst); + Start_Init_Value (Name_Cst); + Finish_Init_Value (Name_Cst, Str_Cst); if Is_Instance then Start_Association (Constr, Ghdl_Get_Instance_Name); else diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 2fa63f9ee..735464ce4 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -2954,7 +2954,7 @@ package body Trans.Chap4 is New_Const_Decl (C, Create_Uniq_Identifier, O_Storage_Private, Ghdl_Location_Type_Node); - Start_Const_Value (C); + Start_Init_Value (C); Start_Record_Aggr (Constr, Ghdl_Location_Type_Node); New_Record_Aggr_El (Constr, New_Global_Address (Current_Filename_Node, Char_Ptr_Type)); @@ -2963,7 +2963,7 @@ package body Trans.Chap4 is New_Record_Aggr_El (Constr, New_Signed_Literal (Ghdl_I32_Type, Integer_64 (Col))); Finish_Record_Aggr (Constr, Aggr); - Finish_Const_Value (C, Aggr); + Finish_Init_Value (C, Aggr); return C; --return New_Global_Address (C, Ghdl_Location_Ptr_Node); diff --git a/src/vhdl/translate/trans-chap8.adb b/src/vhdl/translate/trans-chap8.adb index 3ca0200e4..e10ef1545 100644 --- a/src/vhdl/translate/trans-chap8.adb +++ b/src/vhdl/translate/trans-chap8.adb @@ -1340,7 +1340,7 @@ package body Trans.Chap8 is New_Type_Decl (Create_Uniq_Identifier, Table_Type); New_Const_Decl (Table, Create_Uniq_Identifier, O_Storage_Private, Table_Type); - Start_Const_Value (Table); + Start_Init_Value (Table); Start_Array_Aggr (List, Table_Type); El := First; @@ -1350,7 +1350,7 @@ package body Trans.Chap8 is El := Choices_Info (El).Choice_Chain; end loop; Finish_Array_Aggr (List, Table_Cst); - Finish_Const_Value (Table, Table_Cst); + Finish_Init_Value (Table, Table_Cst); -- Generate table from choice to statements block. Assoc_Table_Base_Type := @@ -1362,7 +1362,7 @@ package body Trans.Chap8 is New_Type_Decl (Create_Uniq_Identifier, Assoc_Table_Type); New_Const_Decl (Assoc_Table, Create_Uniq_Identifier, O_Storage_Private, Assoc_Table_Type); - Start_Const_Value (Assoc_Table); + Start_Init_Value (Assoc_Table); Start_Array_Aggr (List, Assoc_Table_Type); El := First; while El /= No_Choice_Id loop @@ -1373,7 +1373,7 @@ package body Trans.Chap8 is El := Choices_Info (El).Choice_Chain; end loop; Finish_Array_Aggr (List, Table_Cst); - Finish_Const_Value (Assoc_Table, Table_Cst); + Finish_Init_Value (Assoc_Table, Table_Cst); -- Generate dichotomy code. declare diff --git a/src/vhdl/translate/trans-helpers2.adb b/src/vhdl/translate/trans-helpers2.adb index 03e0e8b8b..b6df362ee 100644 --- a/src/vhdl/translate/trans-helpers2.adb +++ b/src/vhdl/translate/trans-helpers2.adb @@ -50,7 +50,7 @@ package body Trans.Helpers2 is Res : O_Cnode; List : O_Array_Aggr_List; begin - Start_Const_Value (Const); + Start_Init_Value (Const); Start_Array_Aggr (List, Const_Type); for I in Str'Range loop New_Array_Aggr_El @@ -59,7 +59,7 @@ package body Trans.Helpers2 is end loop; New_Array_Aggr_El (List, New_Unsigned_Literal (Char_Type_Node, 0)); Finish_Array_Aggr (List, Res); - Finish_Const_Value (Const, Res); + Finish_Init_Value (Const, Res); end Create_String_Value; function Create_String (Str : String; Id : O_Ident) return O_Dnode diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index b72443440..8ac312fd2 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -867,7 +867,7 @@ package body Trans.Rtis is New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Cur_Block.Nbr + 1))); New_Const_Decl (Res, Id, O_Storage_Private, Arr_Type); - Start_Const_Value (Res); + Start_Init_Value (Res); Start_Array_Aggr (List, Arr_Type); Nbr := Cur_Block.Nbr; @@ -896,7 +896,7 @@ package body Trans.Rtis is New_Array_Aggr_El (List, New_Null_Access (Ghdl_Rti_Access)); Finish_Array_Aggr (List, Val); - Finish_Const_Value (Res, Val); + Finish_Init_Value (Res, Val); return Res; end Generate_Rti_Array; @@ -1094,18 +1094,18 @@ package body Trans.Rtis is Unsigned_64 (Nbr_Lit))); New_Const_Decl (Name_Arr, Create_Identifier ("RTINAMES"), O_Storage_Private, Name_Arr_Type); - Start_Const_Value (Name_Arr); + Start_Init_Value (Name_Arr); Start_Array_Aggr (Arr_Aggr, Name_Arr_Type); for I in Name_Lits'Range loop New_Array_Aggr_El (Arr_Aggr, New_Global_Address (Name_Lits (I), Char_Ptr_Type)); end loop; Finish_Array_Aggr (Arr_Aggr, Val); - Finish_Const_Value (Name_Arr, Val); + Finish_Init_Value (Name_Arr, Val); Name := Generate_Type_Name (Atype); - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); case Info.Type_Mode is when Type_Mode_B1 => Kind := Ghdl_Rtik_Type_B1; @@ -1126,7 +1126,7 @@ package body Trans.Rtis is (Rec_Aggr, New_Global_Address (Name_Arr, Char_Ptr_Array_Ptr_Type)); Finish_Record_Aggr (Rec_Aggr, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end; end Generate_Enumeration_Type_Definition; @@ -1146,7 +1146,7 @@ package body Trans.Rtis is return; end if; - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); case Info.Type_Mode is when Type_Mode_I32 => Kind := Ghdl_Rtik_Type_I32; @@ -1163,7 +1163,7 @@ package body Trans.Rtis is New_Record_Aggr_El (List, Generate_Common_Type (Kind, 0, 0)); New_Record_Aggr_El (List, New_Name_Address (Name)); Finish_Record_Aggr (List, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end Generate_Scalar_Type_Definition; procedure Generate_Unit_Declaration (Unit : Iir_Unit_Declaration) @@ -1190,7 +1190,7 @@ package body Trans.Rtis is end if; New_Const_Decl (Const, Create_Identifier ("RTI"), Global_Storage, Rti_Type); - Start_Const_Value (Const); + Start_Init_Value (Const); Start_Record_Aggr (Aggr, Rti_Type); New_Record_Aggr_El (Aggr, Generate_Common (Rtik)); New_Record_Aggr_El (Aggr, New_Name_Address (Name)); @@ -1204,7 +1204,7 @@ package body Trans.Rtis is end if; New_Record_Aggr_El (Aggr, Val); Finish_Record_Aggr (Aggr, Val); - Finish_Const_Value (Const, Val); + Finish_Init_Value (Const, Val); Add_Rti_Node (Const); Pop_Identifier_Prefix (Mark); end Generate_Unit_Declaration; @@ -1239,7 +1239,7 @@ package body Trans.Rtis is Unit_Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); Pop_Rti_Node (Prev); - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (List, Ghdl_Rtin_Type_Physical); case Info.Type_Mode is when Type_Mode_P64 => @@ -1258,7 +1258,7 @@ package body Trans.Rtis is New_Record_Aggr_El (List, New_Global_Address (Unit_Arr, Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end Generate_Physical_Type_Definition; procedure Generate_Scalar_Subtype_Definition (Atype : Iir) @@ -1302,7 +1302,7 @@ package body Trans.Rtis is return; end if; - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (Aggr, Ghdl_Rtin_Subtype_Scalar); New_Record_Aggr_El (Aggr, Generate_Common_Type (Ghdl_Rtik_Subtype_Scalar, @@ -1313,7 +1313,7 @@ package body Trans.Rtis is New_Record_Aggr_El (Aggr, New_Rti_Address (Base_Info.Type_Rti)); New_Record_Aggr_El (Aggr, Var_Acc_To_Loc (Info.T.Range_Var)); Finish_Record_Aggr (Aggr, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end Generate_Scalar_Subtype_Definition; procedure Generate_Fileacc_Type_Definition (Atype : Iir) @@ -1373,14 +1373,14 @@ package body Trans.Rtis is end if; Name := Generate_Type_Name (Atype); - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (List, Ghdl_Rtin_Type_Fileacc); New_Record_Aggr_El (List, Generate_Common_Type (Kind, 0, Info.T.Rti_Max_Depth)); New_Record_Aggr_El (List, New_Name_Address (Name)); New_Record_Aggr_El (List, New_Rti_Address (Base)); Finish_Record_Aggr (List, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end Generate_Fileacc_Type_Definition; procedure Generate_Array_Type_Indexes @@ -1412,7 +1412,7 @@ package body Trans.Rtis is New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Indexes))); New_Const_Decl (Res, Create_Identifier ("RTIINDEXES"), Global_Storage, Arr_Type); - Start_Const_Value (Res); + Start_Init_Value (Res); Start_Array_Aggr (Arr_Aggr, Arr_Type); for I in 1 .. Nbr_Indexes loop @@ -1421,7 +1421,7 @@ package body Trans.Rtis is (Arr_Aggr, New_Rti_Address (Generate_Type_Definition (Index))); end loop; Finish_Array_Aggr (Arr_Aggr, Val); - Finish_Const_Value (Res, Val); + Finish_Init_Value (Res, Val); end Generate_Array_Type_Indexes; function Type_To_Mode (Atype : Iir) return Natural is @@ -1481,7 +1481,7 @@ package body Trans.Rtis is List := Get_Index_Subtype_List (Atype); -- Generate node. - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Array); New_Record_Aggr_El (Aggr, @@ -1495,7 +1495,7 @@ package body Trans.Rtis is Unsigned_64 (Get_Nbr_Elements (List)))); New_Record_Aggr_El (Aggr, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (Aggr, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end Generate_Array_Type_Definition; procedure Generate_Array_Subtype_Definition @@ -1543,7 +1543,7 @@ package body Trans.Rtis is Name := Generate_Type_Name (Atype); - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (Aggr, Ghdl_Rtin_Subtype_Array); case Info.Type_Mode is when Type_Mode_Array => @@ -1588,7 +1588,7 @@ package body Trans.Rtis is end loop; Finish_Record_Aggr (Aggr, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end Generate_Array_Subtype_Definition; procedure Generate_Record_Type_Definition (Atype : Iir) @@ -1634,7 +1634,7 @@ package body Trans.Rtis is El_Name := Generate_Name (El); New_Const_Decl (El_Const, Create_Identifier ("RTIEL"), Global_Storage, Ghdl_Rtin_Element); - Start_Const_Value (El_Const); + Start_Init_Value (El_Const); Start_Record_Aggr (Aggr, Ghdl_Rtin_Element); New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Element)); @@ -1651,7 +1651,7 @@ package body Trans.Rtis is New_Record_Aggr_El (Aggr, Val); end loop; Finish_Record_Aggr (Aggr, Val); - Finish_Const_Value (El_Const, Val); + Finish_Init_Value (El_Const, Val); Add_Rti_Node (El_Const); Pop_Identifier_Prefix (Mark); @@ -1668,7 +1668,7 @@ package body Trans.Rtis is begin Name := Generate_Type_Name (Atype); - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Record); New_Record_Aggr_El (Aggr, @@ -1681,7 +1681,7 @@ package body Trans.Rtis is New_Record_Aggr_El (Aggr, New_Global_Address (El_Arr, Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (Aggr, Res); - Finish_Const_Value (Info.Type_Rti, Res); + Finish_Init_Value (Info.Type_Rti, Res); end; end Generate_Record_Type_Definition; @@ -1699,7 +1699,7 @@ package body Trans.Rtis is end if; Name := Generate_Type_Name (Atype); - Start_Const_Value (Info.Type_Rti); + Start_Init_Value (Info.Type_Rti); Start_Record_Aggr (List, Ghdl_Rtin_Type_Scalar); New_Record_Aggr_El (List, @@ -1707,7 +1707,7 @@ package body Trans.Rtis is Type_To_Mode (Atype))); New_Record_Aggr_El (List, New_Name_Address (Name)); Finish_Record_Aggr (List, Val); - Finish_Const_Value (Info.Type_Rti, Val); + Finish_Init_Value (Info.Type_Rti, Val); end Generate_Protected_Type_Declaration; -- If FORCE is true, force the creation of the type RTI. @@ -1886,7 +1886,7 @@ package body Trans.Rtis is Info := Get_Info (Decl); - Start_Const_Value (Rti); + Start_Init_Value (Rti); Start_Record_Aggr (List, Ghdl_Rtin_Object); Mode := 0; case Get_Kind (Decl) is @@ -1973,7 +1973,7 @@ package body Trans.Rtis is New_Record_Aggr_El (List, New_Rti_Address (Type_Info.Type_Rti)); New_Record_Aggr_El (List, Generate_Linecol (Decl)); Finish_Record_Aggr (List, Val); - Finish_Const_Value (Rti, Val); + Finish_Init_Value (Rti, Val); end if; Pop_Identifier_Prefix (Mark); end Generate_Object; @@ -2009,7 +2009,7 @@ package body Trans.Rtis is Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); - Start_Const_Value (Info.Comp_Rti_Const); + Start_Init_Value (Info.Comp_Rti_Const); Start_Record_Aggr (List, Ghdl_Rtin_Component); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Component)); New_Record_Aggr_El (List, @@ -2020,7 +2020,7 @@ package body Trans.Rtis is New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Res); - Finish_Const_Value (Info.Comp_Rti_Const, Res); + Finish_Init_Value (Info.Comp_Rti_Const, Res); Pop_Rti_Node (Prev); end if; @@ -2121,7 +2121,7 @@ package body Trans.Rtis is New_Const_Decl (Info.Block_Rti_Const, Create_Identifier ("RTI"), Global_Storage, Ghdl_Rtin_Instance); - Start_Const_Value (Info.Block_Rti_Const); + Start_Init_Value (Info.Block_Rti_Const); Start_Record_Aggr (List, Ghdl_Rtin_Instance); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Instance)); New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type)); @@ -2145,7 +2145,7 @@ package body Trans.Rtis is New_Record_Aggr_El (List, Val); Finish_Record_Aggr (List, Val); - Finish_Const_Value (Info.Block_Rti_Const, Val); + Finish_Init_Value (Info.Block_Rti_Const, Val); Add_Rti_Node (Info.Block_Rti_Const); end Generate_Instance; @@ -2165,12 +2165,12 @@ package body Trans.Rtis is New_Const_Decl (Rti, Create_Identifier ("RTI"), O_Storage_Public, Ghdl_Rtin_Type_Scalar); - Start_Const_Value (Rti); + Start_Init_Value (Rti); Start_Record_Aggr (List, Ghdl_Rtin_Type_Scalar); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Psl_Assert)); New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type)); Finish_Record_Aggr (List, Res); - Finish_Const_Value (Rti, Res); + Finish_Init_Value (Rti, Res); Info.Psl_Rti_Const := Rti; Pop_Identifier_Prefix (Mark); end Generate_Psl_Directive; @@ -2362,7 +2362,7 @@ package body Trans.Rtis is Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); - Start_Const_Value (Rti); + Start_Init_Value (Rti); Start_Record_Aggr (List, Ghdl_Rtin_Block); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_If_Generate)); @@ -2385,7 +2385,7 @@ package body Trans.Rtis is New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Res); - Finish_Const_Value (Rti, Res); + Finish_Init_Value (Rti, Res); Pop_Rti_Node (Prev); @@ -2424,7 +2424,7 @@ package body Trans.Rtis is Name := Generate_Name (Blk); - Start_Const_Value (Rti); + Start_Init_Value (Rti); Start_Record_Aggr (List, Ghdl_Rtin_Generate); New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_For_Generate)); @@ -2453,7 +2453,7 @@ package body Trans.Rtis is Finish_Record_Aggr (List, Res); - Finish_Const_Value (Rti, Res); + Finish_Init_Value (Rti, Res); Pop_Rti_Node (Prev); @@ -2574,7 +2574,7 @@ package body Trans.Rtis is Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); - Start_Const_Value (Rti); + Start_Init_Value (Rti); if Rti_Type = Ghdl_Rtin_Block_File then Start_Record_Aggr (List_File, Rti_Type); @@ -2614,7 +2614,7 @@ package body Trans.Rtis is Finish_Record_Aggr (List_File, Res); end if; - Finish_Const_Value (Rti, Res); + Finish_Init_Value (Rti, Res); Pop_Rti_Node (Prev); @@ -2688,12 +2688,12 @@ package body Trans.Rtis is Name := Create_String (Nam_Buffer (1 .. Nam_Length), Create_Identifier_Without_Prefix (Id, "__RTISTR")); - Start_Const_Value (Info.Library_Rti_Const); + Start_Init_Value (Info.Library_Rti_Const); Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Scalar); New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Library)); New_Record_Aggr_El (Aggr, New_Name_Address (Name)); Finish_Record_Aggr (Aggr, Val); - Finish_Const_Value (Info.Library_Rti_Const, Val); + Finish_Init_Value (Info.Library_Rti_Const, Val); end if; end Generate_Library; diff --git a/src/vhdl/translate/trans.adb b/src/vhdl/translate/trans.adb index eca2eacc5..481870f89 100644 --- a/src/vhdl/translate/trans.adb +++ b/src/vhdl/translate/trans.adb @@ -432,16 +432,16 @@ package body Trans is if Storage /= O_Storage_External and then Initial_Value /= O_Cnode_Null then - Start_Const_Value (Res); - Finish_Const_Value (Res, Initial_Value); + Start_Init_Value (Res); + Finish_Init_Value (Res, Initial_Value); end if; return Var_Type'(Kind => Var_Global, E => Res); end Create_Global_Const; procedure Define_Global_Const (Const : in out Var_Type; Val : O_Cnode) is begin - Start_Const_Value (Const.E); - Finish_Const_Value (Const.E, Val); + Start_Init_Value (Const.E); + Finish_Init_Value (Const.E, Val); end Define_Global_Const; function Create_Var |