diff options
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 8 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlprint.adb | 2 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlsynth.adb | 3 | ||||
| -rw-r--r-- | src/vhdl/translate/trans-chap12.adb | 4 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.adb | 55 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.ads | 5 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_lib.adb | 25 | ||||
| -rw-r--r-- | src/vhdl/vhdl-sem_lib.ads | 5 |
8 files changed, 62 insertions, 45 deletions
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index 38fa1c828..ec2356e4b 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -1218,7 +1218,8 @@ package body Ghdllocal is raise Option_Error; end if; - Top := Vhdl.Configuration.Find_Top_Entity (From); + Top := Vhdl.Configuration.Find_Top_Entity + (From, Libraries.Command_Line_Location); if Top = Null_Iir then Error ("no top entity found"); @@ -1318,7 +1319,8 @@ package body Ghdllocal is Set_Design_File_Source (File, Fe); Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop - Vhdl.Sem_Lib.Load_Parse_Design_Unit (Unit, Null_Iir); + Vhdl.Sem_Lib.Load_Parse_Design_Unit + (Unit, Command_Line_Location); Extract_Library_Clauses (Unit); Unit := Get_Chain (Unit); end loop; @@ -1468,7 +1470,7 @@ package body Ghdllocal is Unit := Get_First_Design_Unit (File); while Unit /= Null_Iir loop if not Get_Elab_Flag (Unit) then - Add_Design_Unit (Unit, Null_Iir); + Add_Design_Unit (Unit, Libraries.Command_Line_Location); end if; Unit := Get_Chain (Unit); end loop; diff --git a/src/ghdldrv/ghdlprint.adb b/src/ghdldrv/ghdlprint.adb index ebe9366f8..58186948c 100644 --- a/src/ghdldrv/ghdlprint.adb +++ b/src/ghdldrv/ghdlprint.adb @@ -1379,7 +1379,7 @@ package body Ghdlprint is | Date_Disk => raise Internal_Error; when Date_Parse => - Vhdl.Sem_Lib.Load_Design_Unit (Unit, Unit); + Vhdl.Sem_Lib.Load_Design_Unit (Unit, Get_Location (Unit)); if Errorout.Nbr_Errors /= 0 then raise Compilation_Error; end if; diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index 4166609bd..9fc3a2e98 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -253,7 +253,8 @@ package body Ghdlsynth is -- Elaborate if E_Opt = Args'Last then -- No unit. - Top := Vhdl.Configuration.Find_Top_Entity (Libraries.Work_Library); + Top := Vhdl.Configuration.Find_Top_Entity + (Libraries.Work_Library, Libraries.Command_Line_Location); if Top = Null_Node then Ghdlmain.Error ("no top unit found"); return Null_Iir; diff --git a/src/vhdl/translate/trans-chap12.adb b/src/vhdl/translate/trans-chap12.adb index f153251f6..230a2cc58 100644 --- a/src/vhdl/translate/trans-chap12.adb +++ b/src/vhdl/translate/trans-chap12.adb @@ -359,7 +359,7 @@ package body Trans.Chap12 is Decl : Iir; begin - Load_Design_Unit (Unit, Null_Iir); + Load_Design_Unit (Unit, Libraries.Command_Line_Location); Pkg := Get_Library_Unit (Unit); Reset_Identifier_Prefix; Lib := Get_Library (Get_Design_File (Get_Design_Unit (Pkg))); @@ -433,7 +433,7 @@ package body Trans.Chap12 is Lib_Unit : Iir; begin -- Load the unit in memory to compute the dependence list. - Load_Design_Unit (Unit, Null_Iir); + Load_Design_Unit (Unit, Libraries.Command_Line_Location); Update_Node_Infos; Set_Elab_Flag (Unit, True); diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index 3394ae5ba..5f50a16aa 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -41,8 +41,9 @@ package body Vhdl.Configuration is -- UNIT is a design unit of a configuration declaration. -- Fill the DESIGN_UNITS table with all design units required to build -- UNIT. - procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir) + procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Location_Type) is + Loc : constant Location_Type := Get_Location (Unit); List : Iir_List; It : List_Iterator; El : Iir; @@ -75,13 +76,8 @@ package body Vhdl.Configuration is -- May be enabled to debug dependency construction. if False then - if From = Null_Iir then - Report_Msg (Msgid_Note, Elaboration, +Unit, + Report_Msg (Msgid_Note, Elaboration, +From, "%n added", (1 => +Unit)); - else - Report_Msg (Msgid_Note, Elaboration, +From, - "%n added by %n", (+Unit, +From)); - end if; end if; Lib_Unit := Get_Library_Unit (Unit); @@ -123,12 +119,12 @@ package body Vhdl.Configuration is if El /= Null_Iir then Lib_Unit := Get_Library_Unit (El); if Flag_Build_File_Dependence then - Add_Design_Unit (El, Unit); + Add_Design_Unit (El, Loc); else case Get_Kind (Lib_Unit) is when Iir_Kinds_Package_Declaration | Iir_Kind_Context_Declaration => - Add_Design_Unit (El, Unit); + Add_Design_Unit (El, Loc); when others => null; end case; @@ -154,7 +150,7 @@ package body Vhdl.Configuration is -- find all sub-configuration Load_Design_Unit (Unit, From); Lib_Unit := Get_Library_Unit (Unit); - Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); + Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Loc); declare Blk : Iir_Block_Configuration; Prev_Configuration : Iir_Configuration_Declaration; @@ -166,12 +162,12 @@ package body Vhdl.Configuration is Add_Design_Block_Configuration (Blk); Current_Configuration := Prev_Configuration; Arch := Strip_Denoting_Name (Get_Block_Specification (Blk)); - Add_Design_Unit (Get_Design_Unit (Arch), Unit); + Add_Design_Unit (Get_Design_Unit (Arch), Loc); end; when Iir_Kind_Architecture_Body => -- Add entity -- find all entity/architecture/configuration instantiation - Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Unit); + Add_Design_Unit (Get_Design_Unit (Get_Entity (Lib_Unit)), Loc); Add_Design_Concurrent_Stmts (Lib_Unit); when Iir_Kind_Entity_Declaration | Iir_Kind_Package_Body @@ -224,7 +220,7 @@ package body Vhdl.Configuration is end if; if Bod /= Null_Iir then Set_Package (Get_Library_Unit (Bod), Lib_Unit); - Add_Design_Unit (Bod, Unit); + Add_Design_Unit (Bod, Loc); end if; end; end if; @@ -288,6 +284,7 @@ package body Vhdl.Configuration is is use Libraries; + Loc : Location_Type; Entity : Iir; Arch_Name : Iir; Arch : Iir; @@ -299,6 +296,7 @@ package body Vhdl.Configuration is if Aspect = Null_Iir then return; end if; + Loc := Get_Location (Aspect); case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => -- Add the entity. @@ -308,7 +306,7 @@ package body Vhdl.Configuration is return; end if; Entity := Get_Design_Unit (Entity_Lib); - Add_Design_Unit (Entity, Aspect); + Add_Design_Unit (Entity, Loc); -- Extract and add the architecture. Arch_Name := Get_Architecture (Aspect); @@ -361,16 +359,16 @@ package body Vhdl.Configuration is -- Recursive instantiation. return; else - Add_Design_Unit (Config, Aspect); + Add_Design_Unit (Config, Loc); end if; end if; -- Otherwise, simply the architecture. - Add_Design_Unit (Arch, Aspect); + Add_Design_Unit (Arch, Loc); when Iir_Kind_Entity_Aspect_Configuration => Add_Design_Unit - (Get_Design_Unit (Get_Configuration (Aspect)), Aspect); + (Get_Design_Unit (Get_Configuration (Aspect)), Loc); when Iir_Kind_Entity_Aspect_Open => null; when others => @@ -699,7 +697,7 @@ package body Vhdl.Configuration is Set_Configuration_Mark_Flag (Vhdl.Std_Package.Std_Standard_Unit, True); Set_Configuration_Done_Flag (Vhdl.Std_Package.Std_Standard_Unit, True); - Add_Design_Unit (Top, Null_Iir); + Add_Design_Unit (Top, Command_Line_Location); return Top; end Configure; @@ -729,7 +727,7 @@ package body Vhdl.Configuration is end if; Set_Bound_Vunit_Chain (Vunit, Get_Bound_Vunit_Chain (Name)); Set_Bound_Vunit_Chain (Name, Vunit); - Add_Design_Unit (Get_Design_Unit (Vunit), Vunit); + Add_Design_Unit (Get_Design_Unit (Vunit), Get_Location (Vunit)); end Add_Verification_Unit; procedure Add_Verification_Units @@ -855,7 +853,8 @@ package body Vhdl.Configuration is end Check_Entity_Declaration_Top; package Top is - procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration); + procedure Mark_Instantiated_Units + (Lib : Iir_Library_Declaration; Loc : Location_Type); Nbr_Top_Entities : Natural; First_Top_Entity : Iir; @@ -866,6 +865,8 @@ package body Vhdl.Configuration is package body Top is use Nodes_Walk; + Loc_Err : Location_Type; + -- Add entities to the name table (so that they easily could be found). function Add_Entity_Cb (Design : Iir) return Walk_Status is @@ -881,9 +882,9 @@ package body Vhdl.Configuration is case Iir_Kinds_Library_Unit (Kind) is when Iir_Kind_Architecture_Body | Iir_Kind_Configuration_Declaration => - Load_Design_Unit (Design, Null_Iir); + Load_Design_Unit (Design, Loc_Err); when Iir_Kind_Entity_Declaration => - Load_Design_Unit (Design, Null_Iir); + Load_Design_Unit (Design, Loc_Err); Vhdl.Sem_Scopes.Add_Name (Get_Library_Unit (Design)); when Iir_Kind_Package_Declaration | Iir_Kind_Package_Instantiation_Declaration @@ -998,10 +999,14 @@ package body Vhdl.Configuration is return Walk_Continue; end Mark_Units_Cb; - procedure Mark_Instantiated_Units (Lib : Iir_Library_Declaration) + procedure Mark_Instantiated_Units + (Lib : Iir_Library_Declaration; Loc : Location_Type) is Status : Walk_Status; begin + pragma Assert (Loc /= No_Location); + Loc_Err := Loc; + -- Name table is used to map names to entities. Vhdl.Sem_Scopes.Push_Interpretations; Vhdl.Sem_Scopes.Open_Declarative_Region; @@ -1054,10 +1059,10 @@ package body Vhdl.Configuration is end Top; - function Find_Top_Entity (From : Iir) return Iir is + function Find_Top_Entity (From : Iir; Loc : Location_Type) return Iir is begin -- FROM is a library or a design file. - Top.Mark_Instantiated_Units (From); + Top.Mark_Instantiated_Units (From, Loc); Top.Find_First_Top_Entity (From); if Top.Nbr_Top_Entities = 1 then diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads index f31750a1d..3628f51d6 100644 --- a/src/vhdl/vhdl-configuration.ads +++ b/src/vhdl/vhdl-configuration.ads @@ -39,7 +39,7 @@ package Vhdl.Configuration is return Iir; -- Add design unit UNIT (with its dependences) in the design_units table. - procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir); + procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Location_Type); -- Add all vunits that are bound to any configured entity architecture. procedure Add_Verification_Units; @@ -60,7 +60,8 @@ package Vhdl.Configuration is -- Use heuritics to find the top entity in FROM (either a library or -- a design file): mark all instantiated units and return the unmarked -- one if there is only one. - function Find_Top_Entity (From : Iir) return Iir; + -- LOC is used to report errors. + function Find_Top_Entity (From : Iir; Loc : Location_Type) return Iir; -- Add an override for generic ID. procedure Add_Generic_Override (Id : Name_Id; Value : String); diff --git a/src/vhdl/vhdl-sem_lib.adb b/src/vhdl/vhdl-sem_lib.adb index 2197c6b5e..7144d7725 100644 --- a/src/vhdl/vhdl-sem_lib.adb +++ b/src/vhdl/vhdl-sem_lib.adb @@ -175,7 +175,8 @@ package body Vhdl.Sem_Lib is Set_Dependence_List (Design, Null_Iir_List); end Free_Dependence_List; - procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) + procedure Load_Parse_Design_Unit + (Design_Unit: Iir_Design_Unit; Loc : Location_Type) is use Vhdl.Scanner; Design_File : constant Iir_Design_File := Get_Design_File (Design_Unit); @@ -262,19 +263,16 @@ package body Vhdl.Sem_Lib is Free_Iir (Res); end Load_Parse_Design_Unit; - procedure Error_Obsolete (Loc : Iir; Msg : String; Args : Earg_Arr) is + procedure Error_Obsolete + (Loc : Location_Type; Msg : String; Args : Earg_Arr) is begin if not Flags.Flag_Elaborate_With_Outdated then - if Loc = Null_Iir then - Error_Msg_Sem (Command_Line_Location, Msg, Args); - else - Error_Msg_Sem (+Loc, Msg, Args); - end if; + Error_Msg_Sem (Loc, Msg, Args); end if; end Error_Obsolete; -- Check if one of its dependency makes this unit obsolete. - function Check_Obsolete_Dependence (Design_Unit : Iir; Loc : Iir) + function Check_Obsolete_Dependence (Design_Unit : Iir; Loc : Location_Type) return Boolean is List : constant Iir_List := Get_Dependence_List (Design_Unit); @@ -305,7 +303,8 @@ package body Vhdl.Sem_Lib is return False; end Check_Obsolete_Dependence; - procedure Explain_Obsolete (Design_Unit : Iir_Design_Unit; Loc : Iir) + procedure Explain_Obsolete + (Design_Unit : Iir_Design_Unit; Loc : Location_Type) is List : Iir_List; It : List_Iterator; @@ -333,7 +332,8 @@ package body Vhdl.Sem_Lib is end Explain_Obsolete; -- Load, parse, analyze, back-end a design_unit if necessary. - procedure Load_Design_Unit (Design_Unit : Iir_Design_Unit; Loc : Iir) + procedure Load_Design_Unit + (Design_Unit : Iir_Design_Unit; Loc : Location_Type) is Prev_Nbr_Errors : Natural; Warnings : Warnings_Setting; @@ -420,6 +420,11 @@ package body Vhdl.Sem_Lib is end case; end Load_Design_Unit; + procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir) is + begin + Load_Design_Unit (Design_Unit, Get_Location (Loc)); + end Load_Design_Unit; + function Load_Primary_Unit (Library: Iir_Library_Declaration; Name: Name_Id; Loc : Iir) return Iir_Design_Unit diff --git a/src/vhdl/vhdl-sem_lib.ads b/src/vhdl/vhdl-sem_lib.ads index 97803d8c3..0469b4ff5 100644 --- a/src/vhdl/vhdl-sem_lib.ads +++ b/src/vhdl/vhdl-sem_lib.ads @@ -30,13 +30,16 @@ package Vhdl.Sem_Lib is -- Load, parse, analyze, back-end a design_unit if necessary. -- Check Design_Unit is not obsolete. -- LOC is the location where the design unit was needed, in case of error. + procedure Load_Design_Unit + (Design_Unit: Iir_Design_Unit; Loc : Location_Type); procedure Load_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); -- Load and parse DESIGN_UNIT. -- Contrary to Load_Design_Unit, the design_unit is not analyzed. -- Also, the design_unit must not have been already loaded. -- Used almost only by Load_Design_Unit. - procedure Load_Parse_Design_Unit (Design_Unit: Iir_Design_Unit; Loc : Iir); + procedure Load_Parse_Design_Unit + (Design_Unit: Iir_Design_Unit; Loc : Location_Type); -- Load an already analyzed primary unit NAME from library LIBRARY -- and compile it. |