synth: support multiple synthesis.

7 files changed, 82 insertions, 21 deletions

diff --git a/src/ghdldrv/ghdlsynth.adb b/src/ghdldrv/ghdlsynth.adb
index 856fb2cc8..faa92a6f1 100644
--- a/src/ghdldrv/ghdlsynth.adb
+++ b/src/ghdldrv/ghdlsynth.adb
@@ -131,7 +131,8 @@ package body Ghdlsynth is
 
    --  Init, analyze and configure.
    --  Return the top configuration.
-   function Ghdl_Synth_Configure (Args : Argument_List) return Node
+   function Ghdl_Synth_Configure (Init : Boolean; Args : Argument_List)
+                                 return Node
    is
       use Vhdl.Errors;
       use Vhdl.Configuration;
@@ -153,20 +154,23 @@ package body Ghdlsynth is
          end if;
       end loop;
 
-      Vhdl.Annotations.Flag_Synthesis := True;
-      Vhdl.Scanner.Flag_Comment_Keyword := True;
-      Vhdl.Scanner.Flag_Pragma_Comment := True;
+      if Init then
+         Vhdl.Annotations.Flag_Synthesis := True;
+         Vhdl.Scanner.Flag_Comment_Keyword := True;
+         Vhdl.Scanner.Flag_Pragma_Comment := True;
 
-      Common_Compile_Init (False);
-      --  Will elaborate.
-      Flags.Flag_Elaborate := True;
-      Flags.Flag_Elaborate_With_Outdated := E_Opt >= Args'First;
+         Common_Compile_Init (False);
+         --  Will elaborate.
+         Flags.Flag_Elaborate := True;
 
-      --  Load content only if there are no files.
-      Libraries.Load_Work_Library (E_Opt >= Args'First);
+         --  Load content only if there are no files.
+         Libraries.Load_Work_Library (E_Opt >= Args'First);
 
-      --  Do not canon concurrent statements.
-      Vhdl.Canon.Canon_Flag_Concurrent_Stmts := False;
+         --  Do not canon concurrent statements.
+         Vhdl.Canon.Canon_Flag_Concurrent_Stmts := False;
+      end if;
+
+      Flags.Flag_Elaborate_With_Outdated := E_Opt >= Args'First;
 
       --  Analyze files (if any)
       for I in Args'First .. E_Opt - 1 loop
@@ -239,6 +243,7 @@ package body Ghdlsynth is
       end;
 
       --  Annotate all units.
+      Vhdl.Annotations.Initialize_Annotate;
       Vhdl.Annotations.Annotate (Vhdl.Std_Package.Std_Standard_Unit);
       for I in Design_Units.First .. Design_Units.Last loop
          Vhdl.Annotations.Annotate (Design_Units.Table (I));
@@ -247,9 +252,11 @@ package body Ghdlsynth is
       return Config;
    end Ghdl_Synth_Configure;
 
-   function Ghdl_Synth (Argc : Natural; Argv : C_String_Array_Acc)
-                       return Module
+   function Ghdl_Synth
+     (Init : Natural; Argc : Natural; Argv : C_String_Array_Acc)
+     return Module
    is
+      use Vhdl.Configuration;
       Args : Argument_List (1 .. Argc);
       Res : Module;
       Cmd : Command_Acc;
@@ -270,12 +277,20 @@ package body Ghdlsynth is
       Decode_Command_Options ("--synth", Cmd, Args, First_Arg);
 
       --  Do the real work!
-      Config := Ghdl_Synth_Configure (Args (First_Arg .. Args'Last));
+      Config := Ghdl_Synth_Configure
+        (Init /= 0, Args (First_Arg .. Args'Last));
       if Config = Null_Iir then
          return No_Module;
       end if;
 
       Synthesis.Synth_Design (Config, Res, Inst);
+
+      for I in Design_Units.First .. Design_Units.Last loop
+         Set_Elab_Flag (Design_Units.Table (I), False);
+      end loop;
+
+      Vhdl.Annotations.Finalize_Annotate;
+      Synth.Context.Free_Base_Instance;
       return Res;
 
    exception
@@ -295,7 +310,7 @@ package body Ghdlsynth is
       Config : Iir;
       Ent : Iir;
    begin
-      Config := Ghdl_Synth_Configure (Args);
+      Config := Ghdl_Synth_Configure (True, Args);
 
       if Config = Null_Iir then
          raise Errorout.Compilation_Error;
diff --git a/src/ghdldrv/ghdlsynth.ads b/src/ghdldrv/ghdlsynth.ads
index b4ad92b86..8d36faebc 100644
--- a/src/ghdldrv/ghdlsynth.ads
+++ b/src/ghdldrv/ghdlsynth.ads
@@ -28,6 +28,7 @@ package Ghdlsynth is
    type C_String_Array is array (Natural) of Ghdl_C_String;
    type C_String_Array_Acc is access C_String_Array;
 
-   function Ghdl_Synth (Argc : Natural; Argv : C_String_Array_Acc)
-                       return Module;
+   function Ghdl_Synth
+     (Init : Natural; Argc : Natural; Argv : C_String_Array_Acc)
+     return Module;
 end Ghdlsynth;
diff --git a/src/synth/ghdlsynth.h b/src/synth/ghdlsynth.h
index ae43c2c72..0537ceaf7 100644
--- a/src/synth/ghdlsynth.h
+++ b/src/synth/ghdlsynth.h
@@ -122,10 +122,11 @@ namespace GhdlSynth {
 
   GHDLSYNTH_ADA_WRAPPER_WWD(get_input_net, Net, Instance, Port_Idx);
 
-  extern "C" unsigned int ghdlsynth__ghdl_synth(int argc, const char **argv);
-  inline Module ghdl_synth(int argc, const char **argv) {
+  extern "C" unsigned int ghdlsynth__ghdl_synth(int init,
+                                                int argc, const char **argv);
+  inline Module ghdl_synth(int init, int argc, const char **argv) {
     Module res;
-    res.id = ghdlsynth__ghdl_synth(argc, argv);
+    res.id = ghdlsynth__ghdl_synth(init, argc, argv);
     return res;
   }
 
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb
index ef9569c0c..c02604049 100644
--- a/src/synth/synth-context.adb
+++ b/src/synth/synth-context.adb
@@ -70,6 +70,13 @@ package body Synth.Context is
       return Res;
    end Make_Base_Instance;
 
+   procedure Free_Base_Instance is
+   begin
+      --  TODO: really free.
+      Build_Context := null;
+      Packages_Table.Init;
+   end Free_Base_Instance;
+
    function Make_Instance (Parent : Synth_Instance_Acc;
                            Blk : Node;
                            Name : Sname := No_Sname)
diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads
index f569a092e..e01011256 100644
--- a/src/synth/synth-context.ads
+++ b/src/synth/synth-context.ads
@@ -39,8 +39,12 @@ package Synth.Context is
      (Syn_Inst: Synth_Instance_Acc; Scope: Sim_Info_Acc)
      return Synth_Instance_Acc;
 
+   --  Create the first instance.
    function Make_Base_Instance return Synth_Instance_Acc;
 
+   --  Free the first instance.
+   procedure Free_Base_Instance;
+
    --  Create and free the corresponding synth instance.
    function Make_Instance (Parent : Synth_Instance_Acc;
                            Blk : Node;
diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb
index 9cf6d7931..6a4591430 100644
--- a/src/vhdl/vhdl-annotations.adb
+++ b/src/vhdl/vhdl-annotations.adb
@@ -16,6 +16,8 @@
 --  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
 --  02111-1307, USA.
 
+with Ada.Unchecked_Deallocation;
+
 with Tables;
 with Simple_IO;
 with Vhdl.Std_Package;
@@ -1337,6 +1339,32 @@ package body Vhdl.Annotations is
       end case;
    end Annotate;
 
+   procedure Initialize_Annotate is
+   begin
+      Info_Node.Init;
+   end Initialize_Annotate;
+
+   procedure Finalize_Annotate
+   is
+      procedure Free is new Ada.Unchecked_Deallocation
+        (Sim_Info_Type, Sim_Info_Acc);
+   begin
+      Free (Global_Info);
+      for I in Info_Node.First .. Info_Node.Last loop
+         case Get_Kind (I) is
+            when Iir_Kind_Package_Body
+              | Iir_Kind_Function_Body
+              | Iir_Kind_Procedure_Body
+              | Iir_Kind_Protected_Type_Body =>
+               --  Info is shared with the spec.
+               null;
+            when others =>
+               Free (Info_Node.Table (I));
+         end case;
+      end loop;
+      Info_Node.Free;
+   end Finalize_Annotate;
+
    -- Disp annotations for an iir node.
    procedure Disp_Vhdl_Info (Node: Iir)
    is
diff --git a/src/vhdl/vhdl-annotations.ads b/src/vhdl/vhdl-annotations.ads
index be39173fe..3f0d42938 100644
--- a/src/vhdl/vhdl-annotations.ads
+++ b/src/vhdl/vhdl-annotations.ads
@@ -136,6 +136,11 @@ package Vhdl.Annotations is
       end case;
    end record;
 
+   --  The first initialization is done automatically, but must be done again
+   --  after finalization.
+   procedure Initialize_Annotate;
+   procedure Finalize_Annotate;
+
    --  Decorate the tree in order to be usable with the internal simulator.
    procedure Annotate (Unit : Iir_Design_Unit);