aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2019-07-14 06:49:54 +0200
committerTristan Gingold <tgingold@free.fr>2019-07-14 08:31:58 +0200
commite837a3899bb7d2bd8dc4d99ae0cb10ae0d4a1a75 (patch)
treebd5dd68785a1b3d252cd480646f3fc2733359fdf
parentf0868dcab83c303091a1082d1417a7db64448ee6 (diff)
downloadghdl-e837a3899bb7d2bd8dc4d99ae0cb10ae0d4a1a75.tar.gz
ghdl-e837a3899bb7d2bd8dc4d99ae0cb10ae0d4a1a75.tar.bz2
ghdl-e837a3899bb7d2bd8dc4d99ae0cb10ae0d4a1a75.zip
vhdl: refactoring: remove configure function with string access.
-rw-r--r--src/ghdldrv/ghdlcomp.adb42
-rw-r--r--src/ghdldrv/ghdldrv.adb38
-rw-r--r--src/ghdldrv/ghdllocal.adb58
-rw-r--r--src/ghdldrv/ghdllocal.ads19
-rw-r--r--src/vhdl/translate/ortho_front.adb24
-rw-r--r--src/vhdl/vhdl-configuration.adb14
-rw-r--r--src/vhdl/vhdl-configuration.ads3
-rw-r--r--src/vhdl/vhdl-scanner.ads2
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