vhdl: refactoring: remove configure function with string access.

4 files changed, 81 insertions, 76 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;