diff options
| -rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 3 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 90 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlprint.adb | 3 | ||||
| -rw-r--r-- | src/libraries.adb | 87 | ||||
| -rw-r--r-- | src/libraries.ads | 4 | ||||
| -rw-r--r-- | src/vhdl/back_end.ads | 12 | ||||
| -rw-r--r-- | src/vhdl/canon.adb | 9 | ||||
| -rw-r--r-- | src/vhdl/configuration.adb | 42 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.adb | 21 | ||||
| -rw-r--r-- | src/vhdl/iirs_utils.ads | 4 | ||||
| -rw-r--r-- | src/vhdl/translate/ortho_front.adb | 263 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap12.adb | 35 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap2.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans_be.adb | 123 | ||||
| -rw-r--r-- | src/vhdl/translate/translation.adb | 4 |
15 files changed, 322 insertions, 381 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index 77aa4ebe7..5d7dd7a28 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -26,7 +26,6 @@ with Types; with Iirs; use Iirs; with Nodes_GC; with Flags; -with Back_End; with Sem; with Name_Table; with Errorout; use Errorout; @@ -341,7 +340,7 @@ package body Ghdlcomp is if Design_File /= Null_Iir then Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop - Back_End.Finish_Compilation (Unit, True); + Libraries.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index b1050e5fe..411965374 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -19,24 +19,17 @@ with Ada.Text_IO; use Ada.Text_IO; with Ada.Command_Line; use Ada.Command_Line; with GNAT.Directory_Operations; with Types; use Types; -with Iir_Chains; -with Nodes_Meta; with Libraries; with Std_Package; with Flags; with Name_Table; with Std_Names; -with Back_End; with Disp_Vhdl; with Default_Pathes; with Scanner; -with Sem; -with Canon; with Errorout; with Configuration; with Files_Map; -with Post_Sems; -with Disp_Tree; with Options; with Iirs_Utils; use Iirs_Utils; @@ -48,89 +41,10 @@ package body Ghdllocal is -- If TRUE, generate 32bits code on 64bits machines. Flag_32bit : Boolean := False; - procedure Finish_Compilation - (Unit : Iir_Design_Unit; Main : Boolean := False) - is - use Errorout; - Lib_Unit : constant Iir := Get_Library_Unit (Unit); - Config : Iir_Design_Unit; - begin - if (Main or Flags.Dump_All) and then Flags.Dump_Parse then - Disp_Tree.Disp_Tree (Unit); - end if; - - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, +Unit, - "analyze %n", (1 => +Lib_Unit)); - end if; - - Sem.Semantic (Unit); - - if (Main or Flags.Dump_All) and then Flags.Dump_Sem then - Disp_Tree.Disp_Tree (Unit); - end if; - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - if (Main or Flags.List_All) and then Flags.List_Sem then - Disp_Vhdl.Disp_Vhdl (Unit); - end if; - - Post_Sems.Post_Sem_Checks (Unit); - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - if Flags.Flag_Elaborate - or else ((Main or Flags.List_All) and then Flags.List_Canon) - then - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, No_Location, - "canonicalize %n", (1 => +Lib_Unit)); - end if; - - Canon.Canonicalize (Unit); - - -- FIXME: for Main only ? - if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration - and then not Get_Need_Body (Lib_Unit) - and then Get_Need_Instance_Bodies (Lib_Unit) - then - -- Create the bodies for instances - Set_Package_Instantiation_Bodies_Chain - (Lib_Unit, - Canon.Create_Instantiation_Bodies (Lib_Unit, Lib_Unit)); - elsif Get_Kind (Lib_Unit) = Iir_Kind_Package_Body - and then Get_Need_Instance_Bodies (Get_Package (Lib_Unit)) - then - Iir_Chains.Append_Chain - (Lib_Unit, Nodes_Meta.Field_Declaration_Chain, - Canon.Create_Instantiation_Bodies (Get_Package (Lib_Unit), - Lib_Unit)); - end if; - - if (Main or Flags.List_All) and then Flags.List_Canon then - Disp_Vhdl.Disp_Vhdl (Unit); - end if; - end if; - - if Flags.Flag_Elaborate then - if Get_Kind (Lib_Unit) = Iir_Kind_Architecture_Body then - Config := - Canon.Create_Default_Configuration_Declaration (Lib_Unit); - Set_Default_Configuration_Declaration (Lib_Unit, Config); - end if; - end if; - end Finish_Compilation; - procedure Compile_Init is begin Options.Initialize; Flag_Ieee := Lib_Standard; - Back_End.Finish_Compilation := Finish_Compilation'Access; Flag_Verbose := False; end Compile_Init; @@ -800,7 +714,7 @@ package body Ghdllocal is | Date_Analyzed => null; when Date_Parsed => - Back_End.Finish_Compilation (Unit, False); + Libraries.Finish_Compilation (Unit, False); when others => raise Internal_Error; end case; @@ -865,7 +779,7 @@ package body Ghdllocal is New_Line; end if; -- Sem, canon, annotate a design unit. - Back_End.Finish_Compilation (Unit, True); + Libraries.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index d9c6165a8..d4eb822d6 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -35,7 +35,6 @@ with Xrefs; with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with Disp_Vhdl; -with Back_End; package body Ghdlprint is type Html_Format_Type is (Html_2, Html_Css); @@ -998,7 +997,7 @@ package body Ghdlprint is Unit := Get_First_Design_Unit (Design_File); while Unit /= Null_Iir loop -- Analyze the design unit. - Back_End.Finish_Compilation (Unit, True); + Libraries.Finish_Compilation (Unit, True); Next_Unit := Get_Chain (Unit); if Errorout.Nbr_Errors = 0 then diff --git a/src/libraries.adb b/src/libraries.adb index 36c79579e..bb8b69089 100644 --- a/src/libraries.adb +++ b/src/libraries.adb @@ -23,14 +23,20 @@ with System; with Errorout; use Errorout; with Scanner; with Iirs_Utils; use Iirs_Utils; +with Iir_Chains; +with Nodes_Meta; with Parse; -with Back_End; with Name_Table; use Name_Table; with Str_Table; with Tokens; with Files_Map; with Flags; with Std_Package; +with Disp_Tree; +with Disp_Vhdl; +with Sem; +with Post_Sems; +with Canon; package body Libraries is -- Chain of known libraries. This is also the top node of all iir node. @@ -1541,6 +1547,83 @@ package body Libraries is return False; end Is_Obsolete; + procedure Finish_Compilation + (Unit : Iir_Design_Unit; Main : Boolean := False) + is + Lib_Unit : constant Iir := Get_Library_Unit (Unit); + begin + if (Main or Flags.Dump_All) and then Flags.Dump_Parse then + Disp_Tree.Disp_Tree (Unit); + end if; + + if Flags.Verbose then + Report_Msg (Msgid_Note, Semantic, +Lib_Unit, + "analyze %n", (1 => +Lib_Unit)); + end if; + + Sem.Semantic (Unit); + + if (Main or Flags.Dump_All) and then Flags.Dump_Sem then + Disp_Tree.Disp_Tree (Unit); + end if; + + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + if (Main or Flags.List_All) and then Flags.List_Sem then + Disp_Vhdl.Disp_Vhdl (Unit); + end if; + + -- Post checks + ---------------- + + Post_Sems.Post_Sem_Checks (Unit); + + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + -- Canonalisation. + ------------------ + + if Flags.Verbose then + Report_Msg (Msgid_Note, Semantic, +Lib_Unit, + "canonicalize %n", (1 => +Lib_Unit)); + end if; + + Canon.Canonicalize (Unit); + + -- FIXME: for Main only ? + if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration + and then not Get_Need_Body (Lib_Unit) + and then Get_Need_Instance_Bodies (Lib_Unit) + then + -- Create the bodies for instances + Set_Package_Instantiation_Bodies_Chain + (Lib_Unit, Canon.Create_Instantiation_Bodies (Lib_Unit, Lib_Unit)); + elsif Get_Kind (Lib_Unit) = Iir_Kind_Package_Body + and then Get_Need_Instance_Bodies (Get_Package (Lib_Unit)) + then + Iir_Chains.Append_Chain + (Lib_Unit, Nodes_Meta.Field_Declaration_Chain, + Canon.Create_Instantiation_Bodies (Get_Package (Lib_Unit), + Lib_Unit)); + end if; + + if (Main or Flags.Dump_All) and then Flags.Dump_Canon then + Disp_Tree.Disp_Tree (Unit); + end if; + + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + if (Main or Flags.List_All) and then Flags.List_Canon then + Disp_Vhdl.Disp_Vhdl (Unit); + end if; + end Finish_Compilation; + procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is use Scanner; @@ -1639,7 +1722,7 @@ package body Libraries is -- Avoid infinite recursion, if the unit is self-referenced. Set_Date_State (Design_Unit, Date_Analyze); - Back_End.Finish_Compilation (Design_Unit); + Finish_Compilation (Design_Unit); end if; case Get_Date (Design_Unit) is diff --git a/src/libraries.ads b/src/libraries.ads index 448195822..0a7e04674 100644 --- a/src/libraries.ads +++ b/src/libraries.ads @@ -145,6 +145,10 @@ package Libraries is (Primary: Iir_Design_Unit; Name: Name_Id; Loc : Iir) return Iir_Design_Unit; + -- Analyze UNIT. + procedure Finish_Compilation + (Unit : Iir_Design_Unit; Main : Boolean := False); + -- Get or create a library from an identifier. -- LOC is used only to report errors. function Get_Library (Ident : Name_Id; Loc : Location_Type) diff --git a/src/vhdl/back_end.ads b/src/vhdl/back_end.ads index e9db8bd42..00ac5c429 100644 --- a/src/vhdl/back_end.ads +++ b/src/vhdl/back_end.ads @@ -26,18 +26,6 @@ package Back_End is type Disp_Option_Acc is access procedure; Disp_Option : Disp_Option_Acc := null; - -- UNIT is a design unit from parse. - -- According to the current back-end, do what is necessary. - -- - -- If MAIN is true, then UNIT is a wanted to be analysed design unit, and - -- dump/list options can applied. - -- This avoid to dump/list units fetched (through a selected name or a - -- use clause) indirectly by the main unit. - type Finish_Compilation_Acc is access - procedure (Unit : Iir_Design_Unit; Main : Boolean := False); - - Finish_Compilation : Finish_Compilation_Acc := null; - -- DECL is an architecture (library unit) or a subprogram (specification) -- decorated with a FOREIGN attribute. Do back-end checks. -- May be NULL for no additionnal checks. diff --git a/src/vhdl/canon.adb b/src/vhdl/canon.adb index 30fe6c939..eb1eb9a5a 100644 --- a/src/vhdl/canon.adb +++ b/src/vhdl/canon.adb @@ -2401,11 +2401,10 @@ package body Canon is El := Get_Named_Entity (El); Comp_Conf := Get_Component_Configuration (El); if Comp_Conf /= Null_Iir and then Comp_Conf /= Conf then - if Get_Kind (Comp_Conf) /= Iir_Kind_Configuration_Specification - or else Get_Kind (Conf) /= Iir_Kind_Component_Configuration - then - raise Internal_Error; - end if; + pragma Assert + (Get_Kind (Comp_Conf) = Iir_Kind_Configuration_Specification); + pragma Assert + (Get_Kind (Conf) = Iir_Kind_Component_Configuration); Canon_Incremental_Binding (Comp_Conf, Conf, Parent); else Set_Component_Configuration (El, Conf); diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index b36142595..16554a2fa 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -21,6 +21,7 @@ with Std_Package; with Name_Table; use Name_Table; with Flags; with Iirs_Utils; use Iirs_Utils; +with Canon; package body Configuration is procedure Add_Design_Concurrent_Stmts (Parent : Iir); @@ -282,6 +283,7 @@ package body Configuration is Entity : Iir; Arch : Iir; Config : Iir; + Arch_Lib : Iir; Id : Name_Id; Entity_Lib : Iir; begin @@ -329,17 +331,24 @@ package body Configuration is -- before the architecture in case of recursive instantiation: -- the configuration depends on the architecture. if Add_Default then - Config := Get_Default_Configuration_Declaration - (Get_Library_Unit (Arch)); - if Config /= Null_Iir then - if Get_Configuration_Mark_Flag (Config) - and then not Get_Configuration_Done_Flag (Config) - then - -- Recursive instantiation. - return; - else - Add_Design_Unit (Config, Aspect); - end if; + Arch_Lib := Get_Library_Unit (Arch); + + -- The default configuration may already exist due to a + -- previous instantiation. Create it if it doesn't exist. + Config := Get_Default_Configuration_Declaration (Arch_Lib); + if Is_Null (Config) then + Config := + Canon.Create_Default_Configuration_Declaration (Arch_Lib); + Set_Default_Configuration_Declaration (Arch_Lib, Config); + end if; + + if Get_Configuration_Mark_Flag (Config) + and then not Get_Configuration_Done_Flag (Config) + then + -- Recursive instantiation. + return; + else + Add_Design_Unit (Config, Aspect); end if; end if; @@ -609,11 +618,12 @@ package body Configuration is return Null_Iir; end if; Lib_Unit := Get_Library_Unit (Unit); - Top := Get_Default_Configuration_Declaration (Lib_Unit); - if Top = Null_Iir then - -- No default configuration for this architecture. - raise Internal_Error; - end if; + pragma Assert + (Is_Null (Get_Default_Configuration_Declaration (Lib_Unit))); + + Top := Canon.Create_Default_Configuration_Declaration (Lib_Unit); + Set_Default_Configuration_Declaration (Lib_Unit, Top); + pragma Assert (Is_Valid (Top)); when Iir_Kind_Configuration_Declaration => Top := Unit; when others => diff --git a/src/vhdl/iirs_utils.adb b/src/vhdl/iirs_utils.adb index 19966f306..cf1ecee5b 100644 --- a/src/vhdl/iirs_utils.adb +++ b/src/vhdl/iirs_utils.adb @@ -461,17 +461,24 @@ package body Iirs_Utils is return; end if; - case Get_Kind (Unit) is - when Iir_Kind_Design_Unit - | Iir_Kind_Entity_Aspect_Entity => - null; - when others => - Error_Kind ("add_dependence", Unit); - end case; + pragma Assert (Kind_In (Unit, Iir_Kind_Design_Unit, + Iir_Kind_Entity_Aspect_Entity)); Add_Element (Get_Dependence_List (Target), Unit); end Add_Dependence; + function Get_Unit_From_Dependence (Dep : Iir) return Iir is + begin + case Get_Kind (Dep) is + when Iir_Kind_Design_Unit => + return Dep; + when Iir_Kind_Entity_Aspect_Entity => + return Get_Design_Unit (Get_Entity (Dep)); + when others => + Error_Kind ("get_unit_from_dependence", Dep); + end case; + end Get_Unit_From_Dependence; + procedure Clear_Instantiation_Configuration_Vhdl87 (Parent : Iir; In_Generate : Boolean; Full : Boolean) is diff --git a/src/vhdl/iirs_utils.ads b/src/vhdl/iirs_utils.ads index 843adce7c..fb3f34b8c 100644 --- a/src/vhdl/iirs_utils.ads +++ b/src/vhdl/iirs_utils.ads @@ -96,6 +96,10 @@ package Iirs_Utils is -- UNIT must be either a design unit or a entity_aspect_entity. procedure Add_Dependence (Target: Iir_Design_Unit; Unit: Iir); + -- Get the design_unit from dependency DEP. DEP must be an element of + -- a dependencies list. + function Get_Unit_From_Dependence (Dep : Iir) return Iir; + -- Clear configuration field of all component instantiation of -- the concurrent statements of PARENT. procedure Clear_Instantiation_Configuration (Parent : Iir; Full : Boolean); diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 667bbfe5b..460e588df 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -17,17 +17,16 @@ -- 02111-1307, USA. with Types; use Types; with Name_Table; +with Iirs; use Iirs; +with Libraries; use Libraries; +with Iirs_Utils; use Iirs_Utils; with Std_Package; -with Back_End; with Flags; +with Configuration; with Translation; -with Iirs; use Iirs; -with Libraries; use Libraries; with Sem; with Errorout; use Errorout; with GNAT.OS_Lib; -with Canon; -with Disp_Vhdl; with Bug; with Trans_Be; with Options; @@ -81,8 +80,7 @@ package body Ortho_Front is Flag_Expect_Failure := False; end Init; - function Decode_Elab_Option (Arg : String_Acc) return Natural - is + function Decode_Elab_Option (Arg : String_Acc) return Natural is begin Elab_Architecture := null; -- Entity (+ architecture) to elaborate @@ -220,59 +218,185 @@ package body Ortho_Front is end Decode_Option; - -- Lighter version of libraries.is_obselete, since DESIGN_UNIT must be in - -- the currently analyzed design file. - function Is_Obsolete (Design_Unit : Iir_Design_Unit) return Boolean + -- Add dependencies of UNIT in DEP_LIST. If a UNIT or a unit it depends + -- on is obsolete, later units are not inserted and this function returns + -- FALSE. UNIT is not added to DEP_LIST. + function Add_Dependence (Unit : Iir_Design_Unit; Dep_List : Iir_List) + return Boolean is List : Iir_List; El : Iir; begin - if Get_Date (Design_Unit) = Date_Obsolete then - return True; + if Get_Date (Unit) = Date_Obsolete then + return False; end if; - List := Get_Dependence_List (Design_Unit); + List := Get_Dependence_List (Unit); if Is_Null_List (List) then - return False; + return True; end if; for I in Natural loop El := Get_Nth_Element (List, I); exit when Is_Null (El); - -- FIXME: there may be entity_aspect_entity... - if Get_Kind (El) = Iir_Kind_Design_Unit - and then Get_Date (El) = Date_Obsolete + + El := Get_Unit_From_Dependence (El); + + if not Get_Configuration_Mark_Flag (El) then + -- EL is not in the list. + if not Add_Dependence (El, Dep_List) then + -- FIXME: Also mark UNIT to avoid walking again. + -- FIXME: this doesn't work as Libraries cannot write the .cf + -- file if a unit is obsolete. + -- Set_Date (Unit, Date_Obsolete); + return False; + end if; + + -- Add to the list (only once). + Set_Configuration_Mark_Flag (El, True); + Append_Element (Dep_List, El); + end if; + end loop; + return True; + end Add_Dependence; + + procedure Do_Compile (Vhdl_File : Name_Id) + is + Res : Iir_Design_File; + New_Design_File : Iir_Design_File; + Design : Iir_Design_Unit; + Next_Design : Iir_Design_Unit; + + -- List of dependencies. + Dep_List : Iir_List; + + -- List of units to be compiled. It is generally the same units as the + -- one in the design_file, but some may be removed because a unit can be + -- obsoleted (directly or indirectly) by a later unit in the same file. + Units_List : Iir_List; + begin + -- Do not elaborate. + Flags.Flag_Elaborate := False; + + -- Read and parse the file. + Res := Libraries.Load_File (Vhdl_File); + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + -- Analyze all design units. + -- FIXME: outdate the design file? + New_Design_File := Null_Iir; + Design := Get_First_Design_Unit (Res); + while Is_Valid (Design) loop + -- Analyze and canon a design unit. + Libraries.Finish_Compilation (Design, True); + + Next_Design := Get_Chain (Design); + if Errorout.Nbr_Errors = 0 then + Set_Chain (Design, Null_Iir); + Libraries.Add_Design_Unit_Into_Library (Design); + New_Design_File := Get_Design_File (Design); + end if; + + Design := Next_Design; + end loop; + + if Errorout.Nbr_Errors > 0 then + raise Compilation_Error; + end if; + + -- Must have at least one design unit + pragma Assert (Is_Valid (New_Design_File)); + + -- Do late analysis checks. + Design := Get_First_Design_Unit (New_Design_File); + while Is_Valid (Design) loop + Sem.Sem_Analysis_Checks_List + (Design, Is_Warning_Enabled (Warnid_Delayed_Checks)); + Design := Get_Chain (Design); + end loop; + + -- Gather dependencies + pragma Assert (Flags.Flag_Elaborate = False); + Configuration.Flag_Load_All_Design_Units := False; + + -- Exclude std.standard + Set_Configuration_Mark_Flag (Std_Package.Std_Standard_Unit, True); + Set_Configuration_Done_Flag (Std_Package.Std_Standard_Unit, True); + + Dep_List := Create_Iir_List; + Units_List := Create_Iir_List; + + Design := Get_First_Design_Unit (New_Design_File); + while Is_Valid (Design) loop + if Add_Dependence (Design, Dep_List) then + -- Discard obsolete units. + Append_Element (Units_List, Design); + end if; + Design := Get_Chain (Design); + end loop; + + if Errorout.Nbr_Errors > 0 then + -- Errors can happen (missing package body for instantiation). + raise Compilation_Error; + end if; + + -- Translate declarations of dependencies. + Translation.Translate_Standard (False); + for I in Natural loop + Design := Get_Nth_Element (Dep_List, I); + exit when Design = Null_Iir; + if Get_Design_File (Design) /= New_Design_File then + -- Do not yet translate units to be compiled. They can appear as + -- dependencies. + Translation.Translate (Design, False); + end if; + end loop; + + -- Compile only now. + -- Note: the order of design unit is kept. + for I in Natural loop + Design := Get_Nth_Element (Units_List, I); + exit when Design = Null_Iir; + + if Get_Kind (Get_Library_Unit (Design)) + = Iir_Kind_Configuration_Declaration then - return True; + -- Defer code generation of configuration declaration. + -- (default binding may change between analysis and + -- elaboration). + Translation.Translate (Design, False); + else + Translation.Translate (Design, True); end if; + + if Errorout.Nbr_Errors > 0 then + -- This can happen (foreign attribute). + raise Compilation_Error; + end if; + + Design := Get_Chain (Design); end loop; - return False; - end Is_Obsolete; + + -- Save the working library. + Libraries.Save_Work_Library; + end Do_Compile; Nbr_Parse : Natural := 0; function Parse (Filename : String_Acc) return Boolean is Res : Iir_Design_File; - New_Design_File : Iir_Design_File; Design : Iir_Design_Unit; Next_Design : Iir_Design_Unit; - - -- The vhdl filename to compile. - Vhdl_File : Name_Id; begin if Nbr_Parse = 0 then -- Initialize only once... Libraries.Load_Std_Library; - -- Here, time_base can be set. + -- Here, time_base can be set. Translation.Initialize; - Canon.Canon_Flag_Add_Labels := True; - if Flags.List_All and then Flags.List_Annotate then - Disp_Vhdl.Disp_Vhdl (Std_Package.Std_Standard_Unit); - end if; - - if Action = Action_Anaelab and then Anaelab_Files /= null - then + if Action = Action_Anaelab and then Anaelab_Files /= null then Libraries.Load_Work_Library (True); else Libraries.Load_Work_Library (False); @@ -354,86 +478,15 @@ package body Ortho_Front is Filename.all & """ ignored)"); return False; end if; - Vhdl_File := Name_Table.Get_Identifier (Filename.all); - - Translation.Translate_Standard (False); - - Flags.Flag_Elaborate := False; - Res := Libraries.Load_File (Vhdl_File); - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - -- Analyze all design units. - -- FIXME: outdate the design file? - New_Design_File := Null_Iir; - Design := Get_First_Design_Unit (Res); - while not Is_Null (Design) loop - -- Sem, canon, annotate a design unit. - Back_End.Finish_Compilation (Design, True); - - Next_Design := Get_Chain (Design); - if Errorout.Nbr_Errors = 0 then - Set_Chain (Design, Null_Iir); - Libraries.Add_Design_Unit_Into_Library (Design); - New_Design_File := Get_Design_File (Design); - end if; - - Design := Next_Design; - end loop; - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - -- Do late analysis checks. - Design := Get_First_Design_Unit (New_Design_File); - while not Is_Null (Design) loop - Sem.Sem_Analysis_Checks_List - (Design, Is_Warning_Enabled (Warnid_Delayed_Checks)); - Design := Get_Chain (Design); - end loop; - - -- Compile only now. - if not Is_Null (New_Design_File) then - -- Note: the order of design unit is kept. - Design := Get_First_Design_Unit (New_Design_File); - while not Is_Null (Design) loop - if not Is_Obsolete (Design) then - - if Get_Kind (Get_Library_Unit (Design)) - = Iir_Kind_Configuration_Declaration - then - -- Defer code generation of configuration declaration. - -- (default binding may change between analysis and - -- elaboration). - Translation.Translate (Design, False); - else - Translation.Translate (Design, True); - end if; - - if Errorout.Nbr_Errors > 0 then - -- This can happen (foreign attribute). - raise Compilation_Error; - end if; - end if; - - Design := Get_Chain (Design); - end loop; - end if; - - -- Save the working library. - Libraries.Save_Work_Library; + Do_Compile (Name_Table.Get_Identifier (Filename.all)); end case; + if Flag_Expect_Failure then return False; else return True; end if; exception - --when File_Error => - -- Error_Msg_Option ("cannot open file '" & Filename.all & "'"); - -- return False; when Compilation_Error | Parse_Error => if Flag_Expect_Failure then diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index 931a34990..28883babb 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -243,24 +243,25 @@ package body Trans.Chap12 is end loop; -- Default config. - Config := Get_Library_Unit - (Get_Default_Configuration_Declaration (Arch)); - Config_Info := Get_Info (Config); - if Config_Info /= null then - -- Do not create a trampoline for the default_config if it is not - -- used. - Start_Procedure_Decl - (Inter_List, Create_Identifier ("DEFAULT_CONFIG"), - O_Storage_Public); - New_Interface_Decl (Inter_List, Instance, Wki_Instance, - Arch_Info.Block_Decls_Ptr_Type); - Finish_Subprogram_Decl (Inter_List, Subprg); - - Start_Subprogram_Body (Subprg); - Start_Association (Constr, Config_Info.Config_Subprg); - New_Association (Constr, New_Obj_Value (Instance)); - New_Procedure_Call (Constr); + Config := Get_Default_Configuration_Declaration (Arch); + if Is_Valid (Config) then + Config_Info := Get_Info (Get_Library_Unit (Config)); + if Config_Info /= null then + -- Do not create a trampoline for the default_config if it is not + -- used. + Start_Procedure_Decl + (Inter_List, Create_Identifier ("DEFAULT_CONFIG"), + O_Storage_Public); + New_Interface_Decl (Inter_List, Instance, Wki_Instance, + Arch_Info.Block_Decls_Ptr_Type); + Finish_Subprogram_Decl (Inter_List, Subprg); + + Start_Subprogram_Body (Subprg); + Start_Association (Constr, Config_Info.Config_Subprg); + New_Association (Constr, New_Obj_Value (Instance)); + New_Procedure_Call (Constr); Finish_Subprogram_Body; + end if; end if; Pop_Identifier_Prefix (Arch_Mark); diff --git a/src/vhdl/translate/trans-chap2.adb b/src/vhdl/translate/trans-chap2.adb index 74bb8edeb..f011020f1 100644 --- a/src/vhdl/translate/trans-chap2.adb +++ b/src/vhdl/translate/trans-chap2.adb @@ -1348,8 +1348,7 @@ package body Trans.Chap2 is Instantiate_Info_Package (Inst); Info := Get_Info (Inst); - -- FIXME: if the instantiation occurs within a package declaration, - -- the variable must be declared extern (and public in the body). + -- Create the variable containing data for the package instance. Info.Package_Instance_Body_Var := Create_Var (Create_Var_Identifier (Inst), Get_Scope_Type (Pkg_Info.Package_Body_Scope)); diff --git a/src/vhdl/translate/trans_be.adb b/src/vhdl/translate/trans_be.adb index 2198d48da..9fac3a799 100644 --- a/src/vhdl/translate/trans_be.adb +++ b/src/vhdl/translate/trans_be.adb @@ -16,134 +16,12 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Iirs; use Iirs; -with Nodes_Meta; -with Iir_Chains; -with Disp_Tree; -with Disp_Vhdl; -with Sem; -with Canon; with Translation; with Errorout; use Errorout; -with Post_Sems; -with Flags; with Ada.Text_IO; with Back_End; package body Trans_Be is - procedure Finish_Compilation - (Unit : Iir_Design_Unit; Main : Boolean := False) - is - use Ada.Text_IO; - Lib_Unit : constant Iir := Get_Library_Unit (Unit); - begin - if (Main or Flags.Dump_All) and then Flags.Dump_Parse then - Disp_Tree.Disp_Tree (Unit); - end if; - - -- Semantic analysis. - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, +Lib_Unit, - "analyse %n", (1 => +Lib_Unit)); - end if; - Sem.Semantic (Unit); - - if (Main or Flags.Dump_All) and then Flags.Dump_Sem then - Disp_Tree.Disp_Tree (Unit); - end if; - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - if (Main or Flags.List_All) and then Flags.List_Sem then - Disp_Vhdl.Disp_Vhdl (Unit); - end if; - - -- Post checks - ---------------- - - Post_Sems.Post_Sem_Checks (Unit); - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - -- Canonalisation. - ------------------ - if Flags.Verbose then - Report_Msg (Msgid_Note, Semantic, +Lib_Unit, - "canonicalize %n", (1 => +Lib_Unit)); - end if; - - Canon.Canonicalize (Unit); - - -- FIXME: for Main only ? - if Get_Kind (Lib_Unit) = Iir_Kind_Package_Declaration - and then not Get_Need_Body (Lib_Unit) - and then Get_Need_Instance_Bodies (Lib_Unit) - then - -- Create the bodies for instances - Set_Package_Instantiation_Bodies_Chain - (Lib_Unit, - Canon.Create_Instantiation_Bodies (Lib_Unit, Lib_Unit)); - elsif Get_Kind (Lib_Unit) = Iir_Kind_Package_Body - and then Get_Need_Instance_Bodies (Get_Package (Lib_Unit)) - then - Iir_Chains.Append_Chain - (Lib_Unit, Nodes_Meta.Field_Declaration_Chain, - Canon.Create_Instantiation_Bodies (Get_Package (Lib_Unit), - Lib_Unit)); - end if; - - if (Main or Flags.Dump_All) and then Flags.Dump_Canon then - Disp_Tree.Disp_Tree (Unit); - end if; - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - - if (Main or Flags.List_All) and then Flags.List_Canon then - Disp_Vhdl.Disp_Vhdl (Unit); - end if; - - if Flags.Flag_Elaborate then - if Get_Kind (Lib_Unit) = Iir_Kind_Architecture_Body then - declare - Config : Iir_Design_Unit; - begin - Config := - Canon.Create_Default_Configuration_Declaration (Lib_Unit); - Set_Default_Configuration_Declaration (Lib_Unit, Config); - if (Main or Flags.Dump_All) and then Flags.Dump_Canon then - Disp_Tree.Disp_Tree (Config); - end if; - if (Main or Flags.List_All) and then Flags.List_Canon then - Disp_Vhdl.Disp_Vhdl (Config); - end if; - end; - end if; - - -- Do not translate during elaboration. - -- This is done directly in Translation.Chap12. - return; - end if; - - -- Translation - --------------- - if not Main then - -- Main units (those from the analyzed design file) are translated - -- directly by ortho_front. - - Translation.Translate (Unit, Main); - - if Errorout.Nbr_Errors > 0 then - raise Compilation_Error; - end if; - end if; - - end Finish_Compilation; - procedure Sem_Foreign (Decl : Iir) is use Translation; @@ -190,7 +68,6 @@ package body Trans_Be is procedure Register_Translation_Back_End is begin - Back_End.Finish_Compilation := Finish_Compilation'Access; Back_End.Sem_Foreign := Sem_Foreign'Access; Back_End.Parse_Option := Parse_Option'Access; Back_End.Disp_Option := Disp_Option'Access; diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb index 977162565..1a4703f95 100644 --- a/src/vhdl/translate/translation.adb +++ b/src/vhdl/translate/translation.adb @@ -28,6 +28,7 @@ with Std_Package; use Std_Package; with Sem_Specs; with Libraries; with Std_Names; +with Canon; with Trans; with Trans_Decls; use Trans_Decls; with Trans.Chap1; @@ -362,6 +363,9 @@ package body Translation is begin Init_Node_Infos; + -- Set flags for canon. + Canon.Canon_Flag_Add_Labels := True; + -- Force to unnest subprograms is the code generator doesn't support -- nested subprograms. if not Ortho_Nodes.Has_Nested_Subprograms then |