ghdldrv: refactoring - share more code, isolate ghdlsynth from ghdlsimul.

6 files changed, 111 insertions, 123 deletions

diff --git a/src/ghdldrv/ghdlcomp.adb b/src/ghdldrv/ghdlcomp.adb
index 0282736d5..b2e9cb51f 100644
--- a/src/ghdldrv/ghdlcomp.adb
+++ b/src/ghdldrv/ghdlcomp.adb
@@ -15,22 +15,25 @@
 --  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 Ada.Command_Line;
+
 with Ghdlmain; use Ghdlmain;
 with Ghdllocal; use Ghdllocal;
 with Options; use Options;
 
-with Ada.Command_Line;
-
-with Simple_IO;
 with Types;
 with Flags;
+with Simple_IO;
+with Name_Table;
+with Files_Map;
+
+with Vhdl.Std_Package;
 with Vhdl.Sem;
 with Vhdl.Sem_Lib; use Vhdl.Sem_Lib;
-with Name_Table;
+with Vhdl.Utils;
+with Vhdl.Configuration;
 with Errorout; use Errorout;
 with Libraries;
-with Vhdl.Std_Package;
-with Files_Map;
 with Version;
 
 package body Ghdlcomp is
@@ -294,6 +297,56 @@ package body Ghdlcomp is
       Hooks.Run.all;
    end Compile_Run;
 
+   procedure Common_Compile_Init (Analyze_Only : Boolean) is
+   begin
+      if Analyze_Only then
+         Setup_Libraries (True);
+      else
+         Setup_Libraries (False);
+         Libraries.Load_Std_Library;
+         --  WORK library is not loaded.  FIXME: why ?
+      end if;
+
+      if Time_Resolution /= 'a' then
+         Vhdl.Std_Package.Set_Time_Resolution (Time_Resolution);
+      end if;
+   end Common_Compile_Init;
+
+   procedure Common_Compile_Elab (Cmd_Name : String;
+                                  Args : Argument_List;
+                                  Opt_Arg : out Natural;
+                                  Config : out Iir)
+   is
+      use Types;
+      use Vhdl.Configuration;
+   begin
+      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
+      if Sec_Name = null then
+         Sec_Name := new String'("");
+      end if;
+
+      Flags.Flag_Elaborate := True;
+
+      Config := Vhdl.Configuration.Configure (Prim_Name.all, Sec_Name.all);
+      if Config = Null_Iir then
+         raise Compilation_Error;
+      end if;
+
+      --  Check (and possibly abandon) if entity can be at the top of the
+      --  hierarchy.
+      declare
+         Conf_Unit : constant Iir := Get_Library_Unit (Config);
+         Arch : constant Iir := Get_Named_Entity
+           (Get_Block_Specification (Get_Block_Configuration (Conf_Unit)));
+         Entity : constant Iir := Vhdl.Utils.Get_Entity (Arch);
+      begin
+         Vhdl.Configuration.Check_Entity_Declaration_Top (Entity);
+         if Nbr_Errors > 0 then
+            raise Compilation_Error;
+         end if;
+      end;
+   end Common_Compile_Elab;
+
    procedure Perform_Action (Cmd : Command_Compile;
                              Args : Argument_List)
    is
diff --git a/src/ghdldrv/ghdlcomp.ads b/src/ghdldrv/ghdlcomp.ads
index d20a480a2..c87676d20 100644
--- a/src/ghdldrv/ghdlcomp.ads
+++ b/src/ghdldrv/ghdlcomp.ads
@@ -81,6 +81,18 @@ package Ghdlcomp is
    -- hr => 'h'
    Time_Resolution: Character := 'f';
 
+   --  Common action to perform before analysis: library setup.
+   procedure Common_Compile_Init (Analyze_Only : Boolean);
+
+   --  Common action to perform before elaboration:
+   --  * extract PRIM_NAME and SEC_NAME from ARGS.
+   --  * configure
+   --  * Check top entity.
+   procedure Common_Compile_Elab (Cmd_Name : String;
+                                  Args : Argument_List;
+                                  Opt_Arg : out Natural;
+                                  Config : out Iir);
+
    --  Functionnal interface.
    --  Must be first initialized by Compile_Init
    procedure Compile_Analyze_Init (Load_Work : Boolean := True);
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index fa2525112..93516d60b 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -21,19 +21,19 @@ with GNAT.Directory_Operations;
 
 with Simple_IO; use Simple_IO;
 with Types; use Types;
-with Libraries;
-with Vhdl.Sem_Lib;
-with Vhdl.Std_Package;
 with Flags;
 with Name_Table;
 with Std_Names;
-with Vhdl.Prints;
 with Default_Paths;
-with Vhdl.Scanner;
 with Errorout;
-with Vhdl.Configuration;
 with Files_Map;
+with Libraries;
+with Vhdl.Sem_Lib;
+with Vhdl.Std_Package;
+with Vhdl.Scanner;
+with Vhdl.Configuration;
 with Vhdl.Utils; use Vhdl.Utils;
+with Vhdl.Prints;
 
 package body Ghdllocal is
    --  Version of the IEEE library to use.  This just change paths.
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index 1305ad28a..f82de30e0 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -28,27 +28,25 @@ with Ghdlmain; use Ghdlmain;
 with Ghdllocal; use Ghdllocal;
 with Simple_IO; use Simple_IO;
 
-with Ortho_Jit;
-with Ortho_Nodes; use Ortho_Nodes;
-with Trans_Decls;
-with Vhdl.Nodes; use Vhdl.Nodes;
-with Vhdl.Std_Package;
+with Str_Table;
+with Hash;
+with Interning;
+with Files_Map;
+with Name_Table;
 with Flags;
 with Errorout; use Errorout;
+
+with Vhdl.Nodes; use Vhdl.Nodes;
+with Vhdl.Std_Package;
 with Vhdl.Errors; use Vhdl.Errors;
-with Libraries;
 with Vhdl.Canon;
-with Vhdl.Configuration;
-with Trans_Be;
-with Translation;
 with Vhdl.Ieee.Std_Logic_1164;
-
 with Vhdl.Lists;
-with Str_Table;
-with Hash;
-with Interning;
-with Files_Map;
-with Name_Table;
+with Ortho_Jit;
+with Ortho_Nodes; use Ortho_Nodes;
+with Trans_Decls;
+with Trans_Be;
+with Translation;
 
 with Grt.Main;
 with Grt.Modules;
@@ -119,18 +117,7 @@ package body Ghdlrun is
 
    procedure Compile_Init (Analyze_Only : Boolean) is
    begin
-      if Analyze_Only then
-         Setup_Libraries (True);
-      else
-         Setup_Libraries (False);
-         Libraries.Load_Std_Library;
-         --  WORK library is not loaded.  FIXME: why ?
-      end if;
-
-      if Time_Resolution /= 'a' then
-         Vhdl.Std_Package.Set_Time_Resolution (Time_Resolution);
-      end if;
-
+      Common_Compile_Init (Analyze_Only);
       if Analyze_Only then
          return;
       end if;
@@ -160,17 +147,7 @@ package body Ghdlrun is
    is
       Config : Iir;
    begin
-      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
-      if Sec_Name = null then
-         Sec_Name := new String'("");
-      end if;
-
-      Flags.Flag_Elaborate := True;
-
-      Config := Vhdl.Configuration.Configure (Prim_Name.all, Sec_Name.all);
-      if Config = Null_Iir then
-         raise Compilation_Error;
-      end if;
+      Common_Compile_Elab (Cmd_Name, Args, Opt_Arg, Config);
 
       if Time_Resolution = 'a' then
          Time_Resolution := Vhdl.Std_Package.Get_Minimal_Time_Resolution;
diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb
index a37424409..52408b067 100644
--- a/src/ghdldrv/ghdlsimul.adb
+++ b/src/ghdldrv/ghdlsimul.adb
@@ -24,13 +24,9 @@ with GNAT.OS_Lib; use GNAT.OS_Lib;
 with Simple_IO;
 with Types;
 with Flags;
-with Name_Table;
-with Errorout; use Errorout;
 with Vhdl.Std_Package;
-with Libraries;
 with Vhdl.Canon;
 with Vhdl.Configuration;
-with Vhdl.Utils;
 with Simul.Annotations;
 with Simul.Elaboration;
 with Simul.Simulation.Main;
@@ -52,24 +48,11 @@ package body Ghdlsimul is
 
    procedure Compile_Init (Analyze_Only : Boolean) is
    begin
-      if Analyze_Only then
-         Setup_Libraries (True);
-      else
-         Setup_Libraries (False);
-         Libraries.Load_Std_Library;
-         --  WORK library is not loaded.  FIXME: why ?
-      end if;
-
-      if Time_Resolution /= 'a' then
-         Vhdl.Std_Package.Set_Time_Resolution (Time_Resolution);
-      end if;
-
+      Common_Compile_Init (Analyze_Only);
       if Analyze_Only then
          return;
       end if;
 
-      Simul.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit);
-
       Vhdl.Canon.Canon_Flag_Add_Labels := True;
       Vhdl.Canon.Canon_Flag_Sequentials_Stmts := True;
       Vhdl.Canon.Canon_Flag_Expressions := True;
@@ -79,49 +62,12 @@ package body Ghdlsimul is
    procedure Compile_Elab
      (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural)
    is
-      use Name_Table;
-      use Types;
       use Vhdl.Configuration;
-
-      First_Id : Name_Id;
-      Sec_Id : Name_Id;
    begin
-      Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg);
-
-      Flags.Flag_Elaborate := True;
-      -- Translation.Chap12.Elaborate (Prim_Name.all, Sec_Name.all, "", True);
-
-      if Errorout.Nbr_Errors > 0 then
-         --  This may happen (bad entity for example).
-         raise Compilation_Error;
-      end if;
-
-      First_Id := Get_Identifier (Prim_Name.all);
-      if Sec_Name = null then
-         Sec_Id := Null_Identifier;
-      else
-         Sec_Id := Get_Identifier (Sec_Name.all);
-      end if;
-      Top_Conf := Vhdl.Configuration.Configure (First_Id, Sec_Id);
-      if Top_Conf = Null_Iir then
-         raise Compilation_Error;
-      end if;
-
-      --  Check (and possibly abandon) if entity can be at the top of the
-      --  hierarchy.
-      declare
-         Conf_Unit : constant Iir := Get_Library_Unit (Top_Conf);
-         Arch : constant Iir := Get_Named_Entity
-           (Get_Block_Specification (Get_Block_Configuration (Conf_Unit)));
-         Entity : constant Iir := Vhdl.Utils.Get_Entity (Arch);
-      begin
-         Vhdl.Configuration.Check_Entity_Declaration_Top (Entity);
-         if Nbr_Errors > 0 then
-            raise Compilation_Error;
-         end if;
-      end;
+      Common_Compile_Elab (Cmd_Name, Args, Opt_Arg, Top_Conf);
 
       --  Annotate all units.
+      Simul.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit);
       for I in Design_Units.First .. Design_Units.Last loop
          Simul.Annotations.Annotate (Design_Units.Table (I));
       end loop;
diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index 4e296dc76..d02386eea 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -17,18 +17,17 @@
 --  02111-1307, USA.
 
 with Ghdllocal; use Ghdllocal;
-with Ghdlcomp;
+with Ghdlcomp; use Ghdlcomp;
 with Ghdlmain; use Ghdlmain;
-with Ghdlsimul;
 with Options; use Options;
 
-with Simul.Annotations;
-
 with Libraries;
 with Flags;
+with Vhdl.Nodes; use Vhdl.Nodes;
+with Vhdl.Std_Package;
 with Vhdl.Canon;
-
---  with Simul.Elaboration;
+with Vhdl.Configuration;
+with Simul.Annotations;
 
 with Synthesis;
 with Netlists.Dump;
@@ -79,8 +78,10 @@ package body Ghdlsynth is
 
    function Ghdl_Synth (Args : Argument_List) return Netlists.Module
    is
+      use Vhdl.Configuration;
       E_Opt : Integer;
       Opt_Arg : Natural;
+      Config : Iir;
    begin
       --  If the '-e' switch is present, there is a list of files.
       E_Opt := Args'First - 1;
@@ -93,7 +94,7 @@ package body Ghdlsynth is
 
       Simul.Annotations.Flag_Synthesis := True;
 
-      Ghdlcomp.Hooks.Compile_Init.all (False);
+      Common_Compile_Init (False);
       Flags.Flag_Elaborate_With_Outdated := False;
       Flags.Flag_Only_Elab_Warnings := True;
 
@@ -102,27 +103,26 @@ package body Ghdlsynth is
       --  Do not canon concurrent statements.
       Vhdl.Canon.Canon_Flag_Concurrent_Stmts := False;
 
-      Vhdl.Canon.Canon_Flag_Add_Labels := True;
-
       --  Analyze files (if any)
       for I in Args'First .. E_Opt - 1 loop
          Ghdlcomp.Compile_Analyze_File (Args (I).all);
       end loop;
 
       --  Elaborate
-      Ghdlcomp.Hooks.Compile_Elab.all
-        ("--synth", Args (E_Opt + 1 .. Args'Last), Opt_Arg);
+      Common_Compile_Elab
+        ("--synth", Args (E_Opt + 1 .. Args'Last), Opt_Arg, Config);
 
       if Opt_Arg <= Args'Last then
          Ghdlmain.Error ("extra options ignored");
       end if;
 
-      --  Hooks.Set_Run_Options (Args (Opt_Arg .. Args'Last));
-
-      --  Simul.Elaboration.Elaborate_Design (Ghdlsimul.Get_Top_Config);
+      --  Annotate all units.
+      Simul.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit);
+      for I in Design_Units.First .. Design_Units.Last loop
+         Simul.Annotations.Annotate (Design_Units.Table (I));
+      end loop;
 
-      return Synthesis.Synth_Design (Ghdlsimul.Get_Top_Config);
-      --  Hooks.Run.all;
+      return Synthesis.Synth_Design (Config);
    end Ghdl_Synth;
 
    procedure Perform_Action (Cmd : Command_Synth;