diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ghdldrv/ghdlcomp.adb | 42 | ||||
| -rw-r--r-- | src/ghdldrv/ghdldrv.adb | 38 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.adb | 58 | ||||
| -rw-r--r-- | src/ghdldrv/ghdllocal.ads | 19 | ||||
| -rw-r--r-- | src/vhdl/translate/ortho_front.adb | 24 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.adb | 14 | ||||
| -rw-r--r-- | src/vhdl/vhdl-configuration.ads | 3 | ||||
| -rw-r--r-- | src/vhdl/vhdl-scanner.ads | 2 |
8 files changed, 95 insertions, 105 deletions
diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb index a72cad5a1..452acaa75 100644 --- a/src/ghdldrv/ghdlcomp.adb +++ b/src/ghdldrv/ghdlcomp.adb @@ -21,7 +21,7 @@ with Ghdlmain; use Ghdlmain; with Ghdllocal; use Ghdllocal; with Options; use Options; -with Types; +with Types; use Types; with Flags; with Simple_IO; with Name_Table; @@ -236,7 +236,6 @@ package body Ghdlcomp is function Compile_Analyze_File2 (File : String) return Iir is - use Types; Id : constant Name_Id := Name_Table.Get_Identifier (File); Design_File : Iir_Design_File; New_Design_File : Iir_Design_File; @@ -317,16 +316,16 @@ package body Ghdlcomp is procedure Common_Compile_Elab (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural; - Config : out Iir) is + Config : out Iir) + is + Prim_Id : Name_Id; + Sec_Id : Name_Id; begin - Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg); - if Sec_Name = null then - Sec_Name := new String'(""); - end if; + Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg, Prim_Id, Sec_Id); Flags.Flag_Elaborate := True; - Config := Vhdl.Configuration.Configure (Prim_Name.all, Sec_Name.all); + Config := Vhdl.Configuration.Configure (Prim_Id, Sec_Id); if Config = Null_Iir then raise Compilation_Error; end if; @@ -433,7 +432,6 @@ package body Ghdlcomp is procedure Perform_Action (Cmd : Command_Analyze; Args : Argument_List) is - use Types; pragma Unreferenced (Cmd); Id : Name_Id; Design_File : Iir_Design_File; @@ -700,8 +698,9 @@ package body Ghdlcomp is procedure Perform_Action (Cmd : Command_Make; Args : Argument_List) is pragma Unreferenced (Cmd); - use Types; + Prim_Id : Name_Id; + Sec_Id : Name_Id; Files_List : Iir_List; File : Iir_Design_File; It : List_Iterator; @@ -711,11 +710,11 @@ package body Ghdlcomp is Unit : Iir_Design_Unit; Lib : Iir_Library_Declaration; begin - Extract_Elab_Unit ("-m", Args, Next_Arg); + Extract_Elab_Unit ("-m", Args, Next_Arg, Prim_Id, Sec_Id); Setup_Libraries (True); -- Create list of files. - Files_List := Build_Dependence (Prim_Name, Sec_Name); + Files_List := Build_Dependence (Prim_Id, Sec_Id); -- Unmark all libraries. Lib := Libraries.Std_Library; @@ -835,12 +834,13 @@ package body Ghdlcomp is Args : Argument_List) is pragma Unreferenced (Cmd); - use Types; use Simple_IO; use Ada.Command_Line; use Name_Table; HT : constant Character := ASCII.HT; + Prim_Id : Name_Id; + Sec_Id : Name_Id; Files_List : Iir_List; File : Iir_Design_File; Files_It : List_Iterator; @@ -850,9 +850,9 @@ package body Ghdlcomp is Next_Arg : Natural; begin - Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg); + Extract_Elab_Unit ("--gen-makefile", Args, Next_Arg, Prim_Id, Sec_Id); Setup_Libraries (True); - Files_List := Build_Dependence (Prim_Name, Sec_Name); + Files_List := Build_Dependence (Prim_Id, Sec_Id); Put_Line ("# Makefile automatically generated by ghdl"); Put ("# Version: GHDL "); @@ -916,10 +916,10 @@ package body Ghdlcomp is Put_Line ("# Elaborate target. Almost useless"); Put_Line ("elab : force"); Put (HT & "$(GHDL) -c $(GHDLFLAGS) -e "); - Put (Prim_Name.all); - if Sec_Name /= null then + Put (Image (Prim_Id)); + if Sec_Id /= Null_Identifier then Put (' '); - Put (Sec_Name.all); + Put (Image (Sec_Id)); end if; New_Line; New_Line; @@ -927,10 +927,10 @@ package body Ghdlcomp is Put_Line ("# Run target"); Put_Line ("run : force"); Put (HT & "$(GHDL) -c $(GHDLFLAGS) -r "); - Put (Prim_Name.all); - if Sec_Name /= null then + Put (Image (Prim_Id)); + if Sec_Id /= Null_Identifier then Put (' '); - Put (Sec_Name.all); + Put (Image (Sec_Id)); end if; Put (" $(GHDLRUNFLAGS)"); New_Line; diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb index 463b3e9c6..8daaae6bd 100644 --- a/src/ghdldrv/ghdldrv.adb +++ b/src/ghdldrv/ghdldrv.adb @@ -907,6 +907,8 @@ package body Ghdldrv is -- Elaboration. + Primary_Id : Name_Id; + Secondary_Id : Name_Id; Base_Name : String_Access; Elab_Name : String_Access; Filelist_Name : String_Access; @@ -914,16 +916,17 @@ package body Ghdldrv is procedure Set_Elab_Units (Cmd_Name : String; Args : Argument_List; - Run_Arg : out Natural) - is + Run_Arg : out Natural) is begin - Extract_Elab_Unit (Cmd_Name, Args, Run_Arg); - if Sec_Name = null then - Base_Name := Prim_Name; - Unit_Name := Prim_Name; + Extract_Elab_Unit (Cmd_Name, Args, Run_Arg, 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'(Prim_Name.all & '-' & Sec_Name.all); - Unit_Name := new String'(Prim_Name.all & '(' & Sec_Name.all & ')'); + Base_Name := + new String'(Image (Primary_Id) & '-' & Image (Secondary_Id)); + Unit_Name := + new String'(Image (Primary_Id) & '(' & Image (Secondary_Id) & ')'); end if; Filelist_Name := null; @@ -945,7 +948,8 @@ package body Ghdldrv is end; end Set_Elab_Units; - procedure Set_Elab_Units (Cmd_Name : String; Args : Argument_List) + procedure Set_Elab_Units (Cmd_Name : String; + Args : Argument_List) is Next_Arg : Natural; begin @@ -1150,15 +1154,17 @@ package body Ghdldrv is is pragma Unreferenced (Cmd); Suffix : constant String_Access := Get_Executable_Suffix; + Prim_Id : Name_Id; + Sec_Id : Name_Id; Opt_Arg : Natural; begin - Extract_Elab_Unit ("-r", Args, Opt_Arg); - if Sec_Name = null then + Extract_Elab_Unit ("-r", Args, Opt_Arg, Prim_Id, Sec_Id); + if Sec_Id = Null_Identifier then Base_Name := new String' - (Prim_Name.all & Suffix.all); + (Image (Prim_Id) & Suffix.all); else Base_Name := new String' - (Prim_Name.all & '-' & Sec_Name.all & Suffix.all); + (Image (Prim_Id) & '-' & Image (Sec_Id) & Suffix.all); end if; if not Is_Regular_File (Base_Name.all & Nul) then Error ("file '" & Base_Name.all & "' does not exist"); @@ -1518,7 +1524,7 @@ package body Ghdldrv is Setup_Compiler (True); -- Create list of files. - Files_List := Build_Dependence (Prim_Name, Sec_Name); + Files_List := Build_Dependence (Primary_Id, Secondary_Id); if Errorout.Nbr_Errors /= 0 then raise Errorout.Compilation_Error; @@ -1666,7 +1672,7 @@ package body Ghdldrv is if Need_Elaboration then if not Flag_Verbose then Put ("elaborate "); - Put (Prim_Name.all); + Put (Image (Primary_Id)); --Disp_Library_Unit (Get_Library_Unit (Unit)); New_Line; end if; @@ -1782,7 +1788,7 @@ package body Ghdldrv is end if; Setup_Libraries (True); - Files_List := Build_Dependence (Prim_Name, Sec_Name); + Files_List := Build_Dependence (Primary_Id, Secondary_Id); Put_Line ("# Makefile automatically generated by ghdl"); Put ("# Version: GHDL "); diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb index a49ed5301..08307d7eb 100644 --- a/src/ghdldrv/ghdllocal.adb +++ b/src/ghdldrv/ghdllocal.adb @@ -20,7 +20,6 @@ with Ada.Command_Line; with GNAT.Directory_Operations; with Simple_IO; use Simple_IO; -with Types; use Types; with Flags; with Name_Table; with Std_Names; @@ -1308,8 +1307,7 @@ package body Ghdllocal is end loop; end Check_No_Elab_Flag; - function Build_Dependence (Prim : String_Access; Sec : String_Access) - return Iir_List + function Build_Dependence (Prim : Name_Id; Sec : Name_Id) return Iir_List is procedure Build_Dependence_List (File : Iir_Design_File; List : Iir_List) is @@ -1335,11 +1333,8 @@ package body Ghdllocal is end Build_Dependence_List; use Vhdl.Configuration; - use Name_Table; Top : Iir; - Primary_Id : Name_Id; - Secondary_Id : Name_Id; File : Iir_Design_File; Unit : Iir; @@ -1348,13 +1343,6 @@ package body Ghdllocal is begin Check_No_Elab_Flag (Libraries.Work_Library); - Primary_Id := Get_Identifier (Prim.all); - if Sec /= null then - Secondary_Id := Get_Identifier (Sec.all); - else - Secondary_Id := Null_Identifier; - end if; - if True then -- Load the world. Load_All_Libraries_And_Files; @@ -1397,7 +1385,7 @@ package body Ghdllocal is Flag_Load_All_Design_Units := True; Flag_Build_File_Dependence := True; - Top := Configure (Primary_Id, Secondary_Id); + Top := Configure (Prim, Sec); if Top = Null_Iir then -- Error during configuration (primary unit not found). raise Option_Error; @@ -1543,7 +1531,7 @@ package body Ghdllocal is end Is_File_Outdated; -- Convert NAME to lower cases, unless it is an extended identifier. - function Convert_Name (Name : String_Access) return String_Access + function Convert_Name (Name : String) return Name_Id is function Is_Bad_Unit_Name return Boolean is begin @@ -1598,47 +1586,57 @@ package body Ghdllocal is return False; end Is_A_File_Name; - Res : String_Access; Err : Boolean; begin -- Try to identifier bad names (such as file names), so that -- friendly message can be displayed. if Is_Bad_Unit_Name then - Errorout.Error_Msg_Option ("bad unit name '" & Name.all & "'"); + Errorout.Error_Msg_Option ("bad unit name '" & Name & "'"); if Is_A_File_Name then Errorout.Error_Msg_Option ("(a unit name is required instead of a filename)"); end if; - raise Option_Error; - end if; - Res := new String'(Name.all); - Vhdl.Scanner.Convert_Identifier (Res.all, Err); - if Err then - raise Option_Error; + return Null_Identifier; end if; - return Res; + declare + Res : String := Name; + begin + Vhdl.Scanner.Convert_Identifier (Res, Err); + if Err then + return Null_Identifier; + end if; + return Name_Table.Get_Identifier (Res); + end; end Convert_Name; - procedure Extract_Elab_Unit - (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural) - is + procedure Extract_Elab_Unit (Cmd_Name : String; + Args : Argument_List; + Next_Arg : out Natural; + Prim_Id : out Name_Id; + Sec_Id : out Name_Id) is begin if Args'Length = 0 then Error ("command '" & Cmd_Name & "' requires an unit name"); raise Option_Error; end if; - Prim_Name := Convert_Name (Args (Args'First)); + Prim_Id := Convert_Name (Args (Args'First).all); + if Prim_Id = Null_Identifier then + raise Option_Error; + end if; Next_Arg := Args'First + 1; - Sec_Name := null; + Sec_Id := Null_Identifier; if Args'Length >= 2 then declare Sec : constant String_Access := Args (Next_Arg); begin if Sec (Sec'First) /= '-' then - Sec_Name := Convert_Name (Sec); + Sec_Id := Convert_Name (Sec.all); Next_Arg := Args'First + 2; + if Sec_Id = Null_Identifier then + raise Option_Error; + end if; end if; end; end if; diff --git a/src/ghdldrv/ghdllocal.ads b/src/ghdldrv/ghdllocal.ads index c59cf25a1..ffaceabf9 100644 --- a/src/ghdldrv/ghdllocal.ads +++ b/src/ghdldrv/ghdllocal.ads @@ -15,10 +15,12 @@ -- along with GCC; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. + with GNAT.OS_Lib; use GNAT.OS_Lib; +with Types; use Types; +with Options; use Options; with Ghdlmain; use Ghdlmain; with Vhdl.Nodes; use Vhdl.Nodes; -with Options; use Options; package Ghdllocal is -- Init procedure for the functionnal interface. @@ -129,8 +131,7 @@ package Ghdllocal is -- Raise errorout.compilation_error in case of error (parse error). procedure Load_All_Libraries_And_Files; - function Build_Dependence (Prim : String_Access; Sec : String_Access) - return Iir_List; + function Build_Dependence (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). @@ -140,12 +141,12 @@ package Ghdllocal is -- has been analyzed more recently. function Is_File_Outdated (File : Iir_Design_File) return Boolean; - Prim_Name : String_Access; - Sec_Name : String_Access; - - -- Set PRIM_NAME and SEC_NAME. - procedure Extract_Elab_Unit - (Cmd_Name : String; Args : Argument_List; Next_Arg : out Natural); + -- Extract PRIM_ID and SEC_ID from ARGS. + procedure Extract_Elab_Unit (Cmd_Name : String; + Args : Argument_List; + Next_Arg : out Natural; + Prim_Id : out Name_Id; + Sec_Id : out Name_Id); procedure Register_Commands; end Ghdllocal; diff --git a/src/vhdl/translate/ortho_front.adb b/src/vhdl/translate/ortho_front.adb index 935d5c9d0..77d5c73a3 100644 --- a/src/vhdl/translate/ortho_front.adb +++ b/src/vhdl/translate/ortho_front.adb @@ -61,9 +61,9 @@ package body Ortho_Front is Action : Action_Type := Action_Compile; -- Name of the entity to elaborate. - Elab_Entity : String_Acc; + Elab_Entity : Name_Id; -- Name of the architecture to elaborate. - Elab_Architecture : String_Acc; + Elab_Architecture : Name_Id; -- Filename for the list of files to link. Elab_Filelist : String_Acc; @@ -89,15 +89,15 @@ package body Ortho_Front is Options.Initialize; Elab_Filelist := null; - Elab_Entity := null; - Elab_Architecture := null; + 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 begin - Elab_Architecture := null; + Elab_Architecture := Null_Identifier; -- Entity (+ architecture) to elaborate if Arg = null then Error_Msg_Option @@ -146,12 +146,14 @@ package body Ortho_Front is P := P - 1; end if; end loop; - Elab_Architecture := new String'(Arg (P + 1 .. Arg'Last - 1)); - Elab_Entity := new String'(Arg (Arg'First .. P - 1)); + Elab_Architecture := + Name_Table.Get_Identifier (Arg (P + 1 .. Arg'Last - 1)); + Elab_Entity := + Name_Table.Get_Identifier (Arg (Arg'First .. P - 1)); end; else - Elab_Entity := new String'(Arg.all); - Elab_Architecture := new String'(""); + Elab_Entity := Name_Table.Get_Identifier (Arg.all); + Elab_Architecture := Null_Identifier; end if; return 2; end Decode_Elab_Option; @@ -552,7 +554,7 @@ package body Ortho_Front is Shlib_Interning.Init; Config := Vhdl.Configuration.Configure - (Elab_Entity.all, Elab_Architecture.all); + (Elab_Entity, Elab_Architecture); if Errorout.Nbr_Errors > 0 then -- This may happen (bad entity for example). raise Compilation_Error; @@ -606,7 +608,7 @@ package body Ortho_Front is Flags.Flag_Elaborate := True; Flags.Flag_Only_Elab_Warnings := False; Config := Vhdl.Configuration.Configure - (Elab_Entity.all, Elab_Architecture.all); + (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 c3d2db613..573a0b435 100644 --- a/src/vhdl/vhdl-configuration.adb +++ b/src/vhdl/vhdl-configuration.adb @@ -685,20 +685,6 @@ package body Vhdl.Configuration is return Top; end Configure; - function Configure (Primary : String; Secondary : String) return Iir - is - Primary_Id : Name_Id; - Secondary_Id : Name_Id; - begin - Primary_Id := Get_Identifier (Primary); - if Secondary /= "" then - Secondary_Id := Get_Identifier (Secondary); - else - Secondary_Id := Null_Identifier; - end if; - return Configure (Primary_Id, Secondary_Id); - end Configure; - procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration) is Has_Error : Boolean := False; diff --git a/src/vhdl/vhdl-configuration.ads b/src/vhdl/vhdl-configuration.ads index d38b90366..c6a5105cd 100644 --- a/src/vhdl/vhdl-configuration.ads +++ b/src/vhdl/vhdl-configuration.ads @@ -38,9 +38,6 @@ package Vhdl.Configuration is function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) return Iir; - -- Likewise but directly from strings. - function Configure (Primary : String; Secondary : String) return Iir; - -- Add design unit UNIT (with its dependences) in the design_units table. procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir); diff --git a/src/vhdl/vhdl-scanner.ads b/src/vhdl/vhdl-scanner.ads index e6eedb0b8..1e18cc62f 100644 --- a/src/vhdl/vhdl-scanner.ads +++ b/src/vhdl/vhdl-scanner.ads @@ -132,7 +132,7 @@ package Vhdl.Scanner is -- location of a missing token. function Get_Prev_Location return Location_Type; - -- Convert (canonicalize) an identifier stored in name_buffer/name_length. + -- Convert (canonicalize) identifier STR. -- Upper case letters are converted into lower case. -- Lexical checks are performed. -- This procedure is not used by Scan, but should be used for identifiers |