diff options
author | Tristan Gingold <tgingold@free.fr> | 2016-03-07 06:52:43 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2016-03-07 06:55:05 +0100 |
commit | a7bb5f6944b410d2b02b1ae5aa9fdc10c68d7519 (patch) | |
tree | 3f4308dfe2ce763fb30a6318a947a63bdbb397db /src/vhdl/translate/trans-chap12.adb | |
parent | a82f008211dedcf58e8bbe8ae18e22c9159a1e77 (diff) | |
download | ghdl-a7bb5f6944b410d2b02b1ae5aa9fdc10c68d7519.tar.gz ghdl-a7bb5f6944b410d2b02b1ae5aa9fdc10c68d7519.tar.bz2 ghdl-a7bb5f6944b410d2b02b1ae5aa9fdc10c68d7519.zip |
trans-chap12: refactor.
Diffstat (limited to 'src/vhdl/translate/trans-chap12.adb')
-rw-r--r-- | src/vhdl/translate/trans-chap12.adb | 118 |
1 files changed, 65 insertions, 53 deletions
diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index 779ad97ab..604f48e36 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -36,38 +36,86 @@ with Translation; use Translation; with Trans_Decls; use Trans_Decls; package body Trans.Chap12 is - -- Create __ghdl_ELABORATE - procedure Gen_Main (Entity : Iir_Entity_Declaration; - Arch : Iir_Architecture_Body; - Config_Subprg : O_Dnode; - Nbr_Pkgs : Natural) + Elab_Nbr_Pkgs : Natural; + Pkgs_Arr : O_Dnode; + + -- Declare top RTIARRAY and ghdl_ELABORATE. + procedure Gen_Elab_Decls is - Entity_Info : constant Block_Info_Acc := Get_Info (Entity); - Arch_Info : constant Block_Info_Acc := Get_Info (Arch); Inter_List : O_Inter_List; - Assoc : O_Assoc_List; - Instance : O_Dnode; - Arch_Instance : O_Dnode; - Mark : Id_Mark_Type; Arr_Type : O_Tnode; - Arr : O_Dnode; begin -- We need to create code. Set_Global_Storage (O_Storage_Private); + Rtis.Generate_Top (Elab_Nbr_Pkgs); + + declare + Cst : O_Dnode; + pragma Unreferenced (Cst); + begin + Cst := Create_String (Flags.Flag_String, + Get_Identifier ("__ghdl_flag_string"), + O_Storage_Public); + end; + -- Create the array of RTIs for packages (as a variable, initialized -- during elaboration). Arr_Type := New_Constrained_Array_Type (Rtis.Ghdl_Rti_Array, - New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Pkgs))); - New_Var_Decl (Arr, Get_Identifier ("__ghdl_top_RTIARRAY"), + New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Elab_Nbr_Pkgs))); + New_Var_Decl (Pkgs_Arr, Get_Identifier ("__ghdl_top_RTIARRAY"), O_Storage_Private, Arr_Type); -- The elaboration entry point. Start_Procedure_Decl (Inter_List, Get_Identifier ("__ghdl_ELABORATE"), O_Storage_Public); Finish_Subprogram_Decl (Inter_List, Ghdl_Elaborate); + end Gen_Elab_Decls; + procedure Call_Elab_Decls (Arch : Iir; Arch_Instance : O_Enode) + is + Assoc : O_Assoc_List; + begin + -- Set top instances and RTI. + -- Do it before the elaboration code, since it may be used to + -- diagnose errors. + -- Call ghdl_rti_add_top + Start_Association (Assoc, Ghdl_Rti_Add_Top); + New_Association + (Assoc, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, + Unsigned_64 (Elab_Nbr_Pkgs)))); + New_Association + (Assoc, New_Lit (New_Global_Address + (Pkgs_Arr, Rtis.Ghdl_Rti_Arr_Acc))); + New_Association + (Assoc, + New_Lit (Rtis.New_Rti_Address (Get_Info (Arch).Block_Rti_Const))); + New_Association + (Assoc, New_Convert_Ov (Arch_Instance, Ghdl_Ptr_Type)); + New_Procedure_Call (Assoc); + + -- Add std.standard rti + Start_Association (Assoc, Ghdl_Rti_Add_Package); + New_Association + (Assoc, + New_Lit (Rtis.New_Rti_Address + (Get_Info (Standard_Package).Package_Rti_Const))); + New_Procedure_Call (Assoc); + end Call_Elab_Decls; + + -- Create __ghdl_ELABORATE + procedure Gen_Main (Entity : Iir_Entity_Declaration; + Arch : Iir_Architecture_Body; + Config_Subprg : O_Dnode) + is + Entity_Info : constant Block_Info_Acc := Get_Info (Entity); + Arch_Info : constant Block_Info_Acc := Get_Info (Arch); + Assoc : O_Assoc_List; + Instance : O_Dnode; + Arch_Instance : O_Dnode; + Mark : Id_Mark_Type; + begin Start_Subprogram_Body (Ghdl_Elaborate); New_Var_Decl (Arch_Instance, Wki_Arch_Instance, O_Storage_Local, Arch_Info.Block_Decls_Ptr_Type); @@ -97,30 +145,7 @@ package body Trans.Chap12 is Rtis.Ghdl_Entity_Link_Parent), New_Lit (New_Null_Access (Rtis.Ghdl_Component_Link_Acc))); - -- Set top instances and RTI. - -- Do it before the elaboration code, since it may be used to - -- diagnose errors. - -- Call ghdl_rti_add_top - Start_Association (Assoc, Ghdl_Rti_Add_Top); - New_Association - (Assoc, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type, - Unsigned_64 (Nbr_Pkgs)))); - New_Association - (Assoc, New_Lit (New_Global_Address (Arr, Rtis.Ghdl_Rti_Arr_Acc))); - New_Association - (Assoc, - New_Lit (Rtis.New_Rti_Address (Get_Info (Arch).Block_Rti_Const))); - New_Association - (Assoc, New_Convert_Ov (New_Obj_Value (Arch_Instance), Ghdl_Ptr_Type)); - New_Procedure_Call (Assoc); - - -- Add std.standard rti - Start_Association (Assoc, Ghdl_Rti_Add_Package); - New_Association - (Assoc, - New_Lit (Rtis.New_Rti_Address - (Get_Info (Standard_Package).Package_Rti_Const))); - New_Procedure_Call (Assoc); + Call_Elab_Decls (Arch, New_Obj_Value (Arch_Instance)); Gen_Filename (Get_Design_File (Get_Design_Unit (Entity))); @@ -157,16 +182,6 @@ package body Trans.Chap12 is Current_Filename_Node := O_Dnode_Null; end Gen_Main; - procedure Gen_Setup_Info - is - Cst : O_Dnode; - pragma Unreferenced (Cst); - begin - Cst := Create_String (Flags.Flag_String, - Get_Identifier ("__ghdl_flag_string"), - O_Storage_Public); - end Gen_Setup_Info; - procedure Gen_Last_Arch (Entity : Iir_Entity_Declaration) is Entity_Info : Block_Info_Acc; @@ -561,7 +576,6 @@ package body Trans.Chap12 is Arch : Iir_Architecture_Body; Conf_Info : Config_Info_Acc; Last_Design_Unit : Natural; - Nbr_Pkgs : Natural; begin Config := Configure (Primary, Secondary); if Config = Null_Iir then @@ -679,13 +693,11 @@ package body Trans.Chap12 is end case; end loop; - Rtis.Generate_Top (Nbr_Pkgs); + Gen_Elab_Decls; -- Create main code. Conf_Info := Get_Info (Config_Lib); - Gen_Main (Entity, Arch, Conf_Info.Config_Subprg, Nbr_Pkgs); - - Gen_Setup_Info; + Gen_Main (Entity, Arch, Conf_Info.Config_Subprg); -- Index of the last design unit, required by the design. Last_Design_Unit := Design_Units.Last; |