diff options
| -rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 16 | ||||
| -rw-r--r-- | src/ghdldrv/ghdldrv.adb | 42 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 50 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.ads | 4 | ||||
| -rw-r--r-- | src/ghdldrv/ghdlsynth.adb | 6 | ||||
| -rw-r--r-- | src/vhdl/translate/ortho_front.adb | 32 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.adb | 14 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.ads | 3 |
8 files changed, 129 insertions, 38 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index c62348752..c778ecfb5 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -327,14 +327,15 @@ package body Ghdlcomp is Opt_Arg : out Natural; Config : out Iir) is + Lib_Id : Name_Id; Prim_Id : Name_Id; Sec_Id : Name_Id; begin - Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg, Prim_Id, Sec_Id); + Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg, Lib_Id, Prim_Id, Sec_Id); Flags.Flag_Elaborate := True; - Config := Vhdl.Configuration.Configure (Prim_Id, Sec_Id); + Config := Vhdl.Configuration.Configure (Lib_Id, Prim_Id, Sec_Id); if Config = Null_Iir or else Errorout.Nbr_Errors > 0 then @@ -730,6 +731,7 @@ package body Ghdlcomp is is pragma Unreferenced (Cmd); + Lib_Id : Name_Id; Prim_Id : Name_Id; Sec_Id : Name_Id; Files_List : Iir_List; @@ -741,13 +743,13 @@ package body Ghdlcomp is Unit : Iir_Design_Unit; Lib : Iir_Library_Declaration; begin - Extract_Elab_Unit ("-m", Args, Next_Arg, Prim_Id, Sec_Id); + Extract_Elab_Unit ("-m", Args, Next_Arg, Lib_Id, Prim_Id, Sec_Id); if not Setup_Libraries (True) then return; end if; -- Create list of files. - Files_List := Build_Dependence (Prim_Id, Sec_Id); + Files_List := Build_Dependence (Lib_Id, Prim_Id, Sec_Id); -- Unmark all libraries. Lib := Libraries.Std_Library; @@ -874,6 +876,7 @@ package body Ghdlcomp is use Name_Table; HT : constant Character := ASCII.HT; + Lib_Id : Name_Id; Prim_Id : Name_Id; Sec_Id : Name_Id; Files_List : Iir_List; @@ -885,11 +888,12 @@ package body Ghdlcomp is Next_Arg : Natural; begin - Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg, Prim_Id, Sec_Id); + Extract_Elab_Unit + ("--gen-makefile", Args, Next_Arg, Lib_Id, Prim_Id, Sec_Id); if not Setup_Libraries (True) then return; end if; - Files_List := Build_Dependence (Prim_Id, Sec_Id); + Files_List := Build_Dependence (Lib_Id, Prim_Id, Sec_Id); Ghdllocal.Gen_Makefile_Disp_Header; diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index fea5a9a40..2d56dd821 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -954,6 +954,7 @@ package body Ghdldrv is -- Elaboration. + Library_Id : Name_Id; Primary_Id : Name_Id; Secondary_Id : Name_Id; Base_Name : String_Access; @@ -964,19 +965,39 @@ package body Ghdldrv is procedure Set_Elab_Units (Cmd : in out Command_Comp'Class; Cmd_Name : String; Args : Argument_List; - Run_Arg : out Natural) is + Run_Arg : out Natural) + is + function Library_Prefix_Image (Id : Name_Id) return String is + begin + if Id = Null_Identifier then + return ""; + else + return Image (Id) & '.'; + end if; + end Library_Prefix_Image; + + function Arch_Suffix_Image (Id : Name_Id) return String is + begin + if Id = Null_Identifier then + return ""; + else + return '(' & Image (Id) & ')'; + end if; + end Arch_Suffix_Image; begin - Extract_Elab_Unit (Cmd_Name, Args, Run_Arg, Primary_Id, Secondary_Id); + Library_Id := Null_Identifier; + Extract_Elab_Unit (Cmd_Name, Args, Run_Arg, + Library_Id, Primary_Id, Secondary_Id); if Secondary_Id = Null_Identifier then Base_Name := new String'(Image (Primary_Id)); - Unit_Name := new String'(Image (Primary_Id)); else - Base_Name := - new String'(Image (Primary_Id) & '-' & Image (Secondary_Id)); - Unit_Name := - new String'(Image (Primary_Id) & '(' & Image (Secondary_Id) & ')'); + Base_Name := new String'(Image (Primary_Id) + & '-' & Image (Secondary_Id)); end if; + Unit_Name := new String'(Library_Prefix_Image (Library_Id) + & Image (Primary_Id) + & Arch_Suffix_Image (Secondary_Id)); Filelist_Name := null; -- Choose a default name for the executable. @@ -1231,11 +1252,12 @@ package body Ghdldrv is procedure Perform_Action (Cmd : in out Command_Run; Args : Argument_List) is Suffix : constant String_Access := Get_Executable_Suffix; + Lib_Id : Name_Id; Prim_Id : Name_Id; Sec_Id : Name_Id; Opt_Arg : Natural; begin - Extract_Elab_Unit ("-r", Args, Opt_Arg, Prim_Id, Sec_Id); + Extract_Elab_Unit ("-r", Args, Opt_Arg, Lib_Id, Prim_Id, Sec_Id); if Sec_Id = Null_Identifier then Base_Name := new String' (Image (Prim_Id) & Suffix.all); @@ -1614,7 +1636,7 @@ package body Ghdldrv is Setup_Compiler (Cmd, True); -- Create list of files. - Files_List := Build_Dependence (Primary_Id, Secondary_Id); + Files_List := Build_Dependence (Library_Id, Primary_Id, Secondary_Id); if Errorout.Nbr_Errors /= 0 then raise Errorout.Compilation_Error; @@ -1885,7 +1907,7 @@ package body Ghdldrv is if not Setup_Libraries (True) then raise Option_Error; end if; - Files_List := Build_Dependence (Primary_Id, Secondary_Id); + Files_List := Build_Dependence (Library_Id, Primary_Id, Secondary_Id); Ghdllocal.Gen_Makefile_Disp_Header; diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index b77992520..92a7e1c7e 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -1437,7 +1437,8 @@ package body Ghdllocal is end loop; end Check_No_Elab_Flag; - function Build_Dependence (Prim : Name_Id; Sec : Name_Id) return Iir_List + function Build_Dependence (Lib : Name_Id; Prim : Name_Id; Sec : Name_Id) + return Iir_List is procedure Build_Dependence_List (File : Iir_Design_File; List : Iir_List) is @@ -1515,7 +1516,7 @@ package body Ghdllocal is Flag_Load_All_Design_Units := True; Flag_Build_File_Dependence := True; - Top := Configure (Prim, Sec); + Top := Configure (Lib, Prim, Sec); if Top = Null_Iir then -- Error during configuration (primary unit not found). raise Option_Error; @@ -1742,6 +1743,7 @@ package body Ghdllocal is procedure Extract_Elab_Unit (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural; + Lib_Id : out Name_Id; Prim_Id : out Name_Id; Sec_Id : out Name_Id) is begin @@ -1750,10 +1752,40 @@ package body Ghdllocal is raise Option_Error; end if; - Prim_Id := Convert_Name (Args (Args'First).all); - if Prim_Id = Null_Identifier then - raise Option_Error; - end if; + declare + S : constant String_Access := Args (Args'First); + Dot : Natural; + begin + Lib_Id := Null_Identifier; + + Dot := S'First - 1; + if S (S'First) /= '\' then + for I in S'Range loop + if S (I) = '.' then + if I = S'First then + Error ("missing library name before '.'"); + raise Option_Error; + end if; + if I = S'Last then + Error ("missing primary name after '.'"); + raise Option_Error; + end if; + Dot := I; + Lib_Id := Convert_Name (S (S'First .. Dot - 1)); + if Lib_Id = Null_Identifier then + raise Option_Error; + end if; + exit; + end if; + end loop; + end if; + + Prim_Id := Convert_Name (S (Dot + 1 .. S'Last)); + if Prim_Id = Null_Identifier then + raise Option_Error; + end if; + end; + Next_Arg := Args'First + 1; Sec_Id := Null_Identifier; @@ -1828,6 +1860,7 @@ package body Ghdllocal is pragma Unreferenced (Cmd); use Name_Table; + Lib_Id : Name_Id; Prim_Id : Name_Id; Sec_Id : Name_Id; Files_List : Iir_List; @@ -1838,11 +1871,12 @@ package body Ghdllocal is Next_Arg : Natural; begin - Extract_Elab_Unit ("--elab-order", Args, Next_Arg, Prim_Id, Sec_Id); + Extract_Elab_Unit + ("--elab-order", Args, Next_Arg, Lib_Id, Prim_Id, Sec_Id); if not Setup_Libraries (True) then return; end if; - Files_List := Build_Dependence (Prim_Id, Sec_Id); + Files_List := Build_Dependence (Lib_Id, Prim_Id, Sec_Id); Files_It := List_Iterate (Files_List); while Is_Valid (Files_It) loop diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index 2d0ddb7a8..c182f6c0e 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -130,7 +130,8 @@ package Ghdllocal is -- Raise errorout.compilation_error in case of error (parse error). procedure Load_All_Libraries_And_Files; - function Build_Dependence (Prim : Name_Id; Sec : Name_Id) return Iir_List; + function Build_Dependence (Lib : Name_Id; Prim : Name_Id; Sec : Name_Id) + return Iir_List; -- Return True iff file FILE has been modified (the file time stamp does -- no correspond to what was recorded in the library). @@ -144,6 +145,7 @@ package Ghdllocal is procedure Extract_Elab_Unit (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural; + Lib_Id : out Name_Id; Prim_Id : out Name_Id; Sec_Id : out Name_Id); diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb index b0c85ba26..d95ea55e3 100644 --- a/src/ghdldrv/ghdlsynth.adb +++ b/src/ghdldrv/ghdlsynth.adb @@ -247,6 +247,7 @@ package body Ghdlsynth is Design_File : Iir; Config : Iir; Top : Iir; + Lib_Id : Name_Id; Prim_Id : Name_Id; Sec_Id : Name_Id; begin @@ -359,18 +360,19 @@ package body Ghdlsynth is -- No need to configure if there are missing units. return Null_Iir; end if; + Lib_Id := Null_Identifier; Prim_Id := Get_Identifier (Top); Sec_Id := Null_Identifier; else Extract_Elab_Unit ("--synth", Args (E_Opt + 1 .. Args'Last), Opt_Arg, - Prim_Id, Sec_Id); + Lib_Id, Prim_Id, Sec_Id); if Opt_Arg <= Args'Last then Ghdlmain.Error ("extra options ignored"); return Null_Iir; end if; end if; - Config := Vhdl.Configuration.Configure (Prim_Id, Sec_Id); + Config := Vhdl.Configuration.Configure (Lib_Id, Prim_Id, Sec_Id); if Nbr_Errors > 0 then -- No need to configure if there are missing units. diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 8823705bb..a1364a243 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -58,9 +58,9 @@ package body Ortho_Front is ); Action : Action_Type := Action_Compile; - -- Name of the entity to elaborate. + -- Name of the library/entity/architecture to elaborate. + Elab_Library : Name_Id; Elab_Entity : Name_Id; - -- Name of the architecture to elaborate. Elab_Architecture : Name_Id; -- Filename for the list of files to link. Elab_Filelist : String_Acc; @@ -90,13 +90,16 @@ package body Ortho_Front is Options.Initialize; Elab_Filelist := null; + Elab_Library := Null_Identifier; Elab_Entity := Null_Identifier; Elab_Architecture := Null_Identifier; Flag_Expect_Failure := False; end Init; function Decode_Elab_Option (Arg : String_Acc; Cmd : String) - return Natural is + return Natural + is + Dot : Natural; begin Elab_Architecture := Null_Identifier; -- Entity (+ architecture) to elaborate @@ -105,6 +108,19 @@ package body Ortho_Front is ("entity or configuration name required after " & Cmd); return 0; end if; + + Dot := Arg'First - 1; + if Arg (Arg'First) /= '\' then + for I in Arg'Range loop + if Arg (I) = '.' then + Dot := I; + Elab_Library := + Name_Table.Get_Identifier (Arg (Arg'First .. I - 1)); + exit; + end if; + end loop; + end if; + if Arg (Arg.all'Last) = ')' then -- Name is ENTITY(ARCH). -- Split. @@ -128,7 +144,7 @@ package body Ortho_Front is Is_Ext := False; end if; loop - if P = Arg.all'First then + if P = Dot + 1 then Error_Msg_Option ("ill-formed name after " & Cmd); return 0; end if; @@ -150,10 +166,10 @@ package body Ortho_Front is Elab_Architecture := Name_Table.Get_Identifier (Arg (P + 1 .. Arg'Last - 1)); Elab_Entity := - Name_Table.Get_Identifier (Arg (Arg'First .. P - 1)); + Name_Table.Get_Identifier (Arg (Dot + 1 .. P - 1)); end; else - Elab_Entity := Name_Table.Get_Identifier (Arg.all); + Elab_Entity := Name_Table.Get_Identifier (Arg (Dot + 1 .. Arg'Last)); Elab_Architecture := Null_Identifier; end if; return 2; @@ -567,7 +583,7 @@ package body Ortho_Front is Shlib_Interning.Init; Config := Vhdl.Configuration.Configure - (Elab_Entity, Elab_Architecture); + (Elab_Library, Elab_Entity, Elab_Architecture); if Errorout.Nbr_Errors > 0 then -- This may happen (bad entity for example). raise Compilation_Error; @@ -626,7 +642,7 @@ package body Ortho_Front is Flags.Flag_Elaborate := True; Flags.Flag_Only_Elab_Warnings := False; Config := Vhdl.Configuration.Configure - (Elab_Entity, Elab_Architecture); + (Elab_Library, Elab_Entity, Elab_Architecture); Translation.Elaborate (Config, True); if Errorout.Nbr_Errors > 0 then diff --git a/src/vhdl/vhdl-configuration.adb b/src/vhdl/vhdl-configuration.adb index 395888d69..ad086cd3d 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -638,16 +638,26 @@ package body Vhdl.Configuration is -- corresponding configurations. -- -- Return the configuration declaration for the design. - function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) + function Configure + (Library_Id: Name_Id; Primary_Id : Name_Id; Secondary_Id : Name_Id) return Iir is use Libraries; + Library : Iir; Unit : Iir_Design_Unit; Lib_Unit : Iir; Top : Iir; begin - Unit := Find_Primary_Unit (Work_Library, Primary_Id); + if Library_Id /= Null_Identifier then + Library := Get_Library (Library_Id, Command_Line_Location); + if Library = Null_Iir then + return Null_Iir; + end if; + else + Library := Work_Library; + end if; + Unit := Find_Primary_Unit (Library, Primary_Id); if Unit = Null_Iir then Error_Msg_Elab ("cannot find entity or configuration " & Name_Table.Image (Primary_Id)); diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads index c9fd50850..1abff5057 100644 --- a/src/vhdl/vhdl-configuration.ads +++ b/src/vhdl/vhdl-configuration.ads @@ -33,7 +33,8 @@ package Vhdl.Configuration is -- creates a list of design unit. -- and return the top configuration. -- Note: this set the Elab_Flag on units. - function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) + function Configure + (Library_Id : Name_Id; Primary_Id : Name_Id; Secondary_Id : Name_Id) return Iir; -- Add design unit UNIT (with its dependences) in the design_units table. |