synth: factorize code to create base instance

src/synth/synth-context.ads

@@ -0,0 +1,31 @@
+--  Synthesis context.
+--  Copyright (C) 2017 Tristan Gingold
+--
+--  This file is part of GHDL.
+--
+--  This program is free software: you can redistribute it and/or modify
+--  it under the terms of the GNU General Public License as published by
+--  the Free Software Foundation, either version 2 of the License, or
+--  (at your option) any later version.
+--
+--  This program is distributed in the hope that it will be useful,
+--  but WITHOUT ANY WARRANTY; without even the implied warranty of
+--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+--  GNU General Public License for more details.
+--
+--  You should have received a copy of the GNU General Public License
+--  along with this program.  If not, see <gnu.org/licenses>.
+
+with Netlists; use Netlists;
+with Netlists.Builders; use Netlists.Builders;
+
+package Synth.Context is
+   type Base_Instance_Type is limited record
+      Builder : Context_Acc;
+      Top_Module : Module;
+
+      Cur_Module : Module;
+   end record;
+
+   type Base_Instance_Acc is access Base_Instance_Type;
+end Synth.Context;

src/synth/synth-vhdl_context.adb

@@ -18,7 +18,6 @@
 
 with Ada.Unchecked_Deallocation;
 
-with Name_Table; use Name_Table;
 with Types_Utils; use Types_Utils;
 
 with Vhdl.Errors; use Vhdl.Errors;
@@ -30,21 +29,11 @@ with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
 with Netlists.Locations;
 
 package body Synth.Vhdl_Context is
-   function Make_Base_Instance return Synth_Instance_Acc
+   function Make_Base_Instance (Base : Base_Instance_Acc)
+                               return Synth_Instance_Acc
    is
-      Base : Base_Instance_Acc;
-      Top_Module : Module;
       Res : Synth_Instance_Acc;
-      Ctxt : Context_Acc;
    begin
-      Top_Module :=
-        New_Design (New_Sname_Artificial (Get_Identifier ("top"), No_Sname));
-      Ctxt := Build_Builders (Top_Module);
-
-      Base := new Base_Instance_Type'(Builder => Ctxt,
-                                      Top_Module => Top_Module,
-                                      Cur_Module => No_Module);
-
       Res := new Synth_Instance_Type'(Max_Objs => Global_Info.Nbr_Objects,
                                       Is_Const => False,
                                       Is_Error => False,

src/synth/synth-vhdl_context.ads

@@ -24,6 +24,7 @@ with Netlists.Builders; use Netlists.Builders;
 with Vhdl.Annotations; use Vhdl.Annotations;
 with Vhdl.Nodes; use Vhdl.Nodes;
 
+with Synth.Context; use Synth.Context;
 with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
 with Synth.Objtypes; use Synth.Objtypes;
 with Synth.Values; use Synth.Values;
@@ -40,7 +41,8 @@ package Synth.Vhdl_Context is
      return Synth_Instance_Acc;
 
    --  Create the first instance.
-   function Make_Base_Instance return Synth_Instance_Acc;
+   function Make_Base_Instance (Base : Base_Instance_Acc)
+                               return Synth_Instance_Acc;
 
    --  Free the first instance.
    procedure Free_Base_Instance;
@@ -159,15 +161,6 @@ private
 
    type Objects_Array is array (Object_Slot_Type range <>) of Obj_Type;
 
-   type Base_Instance_Type is limited record
-      Builder : Context_Acc;
-      Top_Module : Module;
-
-      Cur_Module : Module;
-   end record;
-
-   type Base_Instance_Acc is access Base_Instance_Type;
-
    type Synth_Instance_Type (Max_Objs : Object_Slot_Type) is limited record
       Is_Const : Boolean;
 

src/synth/synth-vhdl_insts.adb

@@ -1402,20 +1402,37 @@ package body Synth.Vhdl_Insts is
       end loop;
    end Synth_Dependencies;
 
-   procedure Synth_Top_Entity (Global_Instance : Synth_Instance_Acc;
-                               Arch : Node;
-                               Config : Node;
+   procedure Synth_Top_Entity (Base : Base_Instance_Acc;
+                               Design_Unit : Node;
                                Encoding : Name_Encoding;
                                Inst : out Synth_Instance_Acc)
    is
-      Entity : constant Node := Get_Entity (Arch);
+      Lib_Unit : constant Node := Get_Library_Unit (Design_Unit);
+      Arch : Node;
+      Entity : Node;
+      Config : Node;
       Syn_Inst : Synth_Instance_Acc;
       Inter : Node;
       Inter_Typ : Type_Acc;
       Inst_Obj : Inst_Object;
       Val : Valtyp;
    begin
-      Root_Instance := Global_Instance;
+      --  Extract architecture from design.
+      case Get_Kind (Lib_Unit) is
+         when Iir_Kind_Architecture_Body =>
+            Arch := Lib_Unit;
+            Config := Get_Library_Unit
+              (Get_Default_Configuration_Declaration (Arch));
+         when Iir_Kind_Configuration_Declaration =>
+            Config := Lib_Unit;
+            Arch := Get_Named_Entity
+              (Get_Block_Specification (Get_Block_Configuration (Lib_Unit)));
+         when others =>
+            raise Internal_Error;
+      end case;
+      Entity := Get_Entity (Arch);
+
+      Root_Instance := Make_Base_Instance (Base);
 
       Insts_Interning.Init;
 
@@ -1424,11 +1441,11 @@ package body Synth.Vhdl_Insts is
       end if;
 
       --  Dependencies first.
-      Synth_Dependencies (Global_Instance, Get_Design_Unit (Entity));
-      Synth_Dependencies (Global_Instance, Get_Design_Unit (Arch));
+      Synth_Dependencies (Root_Instance, Get_Design_Unit (Entity));
+      Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch));
 
       Syn_Inst := Make_Instance
-        (Global_Instance, Arch,
+        (Root_Instance, Arch,
          New_Sname_User (Get_Identifier (Entity), No_Sname));
 
       --  Compute generics.

src/synth/synth-vhdl_insts.ads

@@ -18,14 +18,14 @@
 
 with Vhdl.Nodes; use Vhdl.Nodes;
 
+with Synth.Context; use Synth.Context;
 with Synth.Vhdl_Context; use Synth.Vhdl_Context;
 with Synth.Flags; use Synth.Flags;
 
 package Synth.Vhdl_Insts is
    --  Create the declaration of the top entity.
-   procedure Synth_Top_Entity (Global_Instance : Synth_Instance_Acc;
-                               Arch : Node;
-                               Config : Node;
+   procedure Synth_Top_Entity (Base : Base_Instance_Acc;
+                               Design_Unit : Node;
                                Encoding : Name_Encoding;
                                Inst : out Synth_Instance_Acc);
 

src/synth/synthesis.adb

@@ -16,8 +16,8 @@
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
 
-with Types; use Types;
 with Errorout; use Errorout;
+with Name_Table; use Name_Table;
 
 with Netlists.Cleanup;
 with Netlists.Memories;
@@ -26,46 +26,56 @@ with Netlists.Expands;
 with Synth.Objtypes;
 with Synth.Vhdl_Insts; use Synth.Vhdl_Insts;
 
+
 with Synth.Values.Debug;
 pragma Unreferenced (Synth.Values.Debug);
 
 package body Synthesis is
+   function Make_Base_Instance return Base_Instance_Acc
+   is
+      Base : Base_Instance_Acc;
+      Top_Module : Module;
+      Ctxt : Context_Acc;
+   begin
+      Top_Module :=
+        New_Design (New_Sname_Artificial (Get_Identifier ("top"), No_Sname));
+      Ctxt := Build_Builders (Top_Module);
+
+      Base := new Base_Instance_Type'(Builder => Ctxt,
+                                      Top_Module => Top_Module,
+                                      Cur_Module => No_Module);
+      return Base;
+   end Make_Base_Instance;
+
    procedure Synth_Design (Design : Node;
                            Encoding : Name_Encoding;
                            M : out Module;
                            Inst : out Synth_Instance_Acc)
    is
-      Unit : constant Node := Get_Library_Unit (Design);
-      Arch : Node;
-      Config : Node;
-      Global_Instance : Synth_Instance_Acc;
+      Base : Base_Instance_Acc;
    begin
-      --  Extract architecture from design.
-      case Get_Kind (Unit) is
-         when Iir_Kind_Architecture_Body =>
-            Arch := Unit;
-            Config := Get_Library_Unit
-              (Get_Default_Configuration_Declaration (Arch));
-         when Iir_Kind_Configuration_Declaration =>
-            Config := Unit;
-            Arch := Get_Named_Entity
-              (Get_Block_Specification (Get_Block_Configuration (Unit)));
-         when others =>
-            raise Internal_Error;
-      end case;
-
-      Global_Instance := Make_Base_Instance;
+      Base := Make_Base_Instance;
 
       Synth.Objtypes.Init;
 
-      Synth_Top_Entity (Global_Instance, Arch, Config, Encoding, Inst);
-      Synth_All_Instances;
+      case Iir_Kinds_Design_Unit (Get_Kind (Design)) is
+         when Iir_Kind_Foreign_Module =>
+            if Synth_Top_Foreign = null then
+               raise Internal_Error;
+            end if;
+            Synth_Top_Foreign (Base, Get_Foreign_Node (Design), Encoding);
+         when Iir_Kind_Design_Unit =>
+            Synth_Top_Entity (Base, Design, Encoding, Inst);
+      end case;
+
+      Synth.Vhdl_Insts.Synth_All_Instances;
+
       if Errorout.Nbr_Errors > 0 then
          M := No_Module;
          return;
       end if;
 
-      M := Get_Top_Module (Global_Instance);
+      M := Base.Top_Module;
    end Synth_Design;
 
    procedure Instance_Passes (Ctxt : Context_Acc; M : Module) is

src/synth/synthesis.ads

@@ -16,11 +16,13 @@
 --  You should have received a copy of the GNU General Public License
 --  along with this program.  If not, see <gnu.org/licenses>.
 
+with Types; use Types;
 with Vhdl.Nodes; use Vhdl.Nodes;
 
 with Netlists; use Netlists;
 with Netlists.Builders; use Netlists.Builders;
 
+with Synth.Context; use Synth.Context;
 with Synth.Vhdl_Context; use Synth.Vhdl_Context;
 with Synth.Flags; use Synth.Flags;
 
@@ -33,5 +35,10 @@ package Synthesis is
    --  Run cleanup/memory extraction/expand passes on M.
    procedure Instance_Passes (Ctxt : Context_Acc; M : Module);
 
+   --  Function to be called for a foreign top-level module.
+   type Synth_Top_Acc is access procedure
+     (Base : Base_Instance_Acc; Unit : Int32; Encoding : Name_Encoding);
+   Synth_Top_Foreign : Synth_Top_Acc;
+
    Synth_Error : exception;
 end Synthesis;