synth: add hooks to support elaboration of foreign instances

10 files changed, 108 insertions, 32 deletions

diff --git a/src/synth/elab-vhdl_context.adb b/src/synth/elab-vhdl_context.adb
index 7235ef04d..8bf97e0c4 100644
--- a/src/synth/elab-vhdl_context.adb
+++ b/src/synth/elab-vhdl_context.adb
@@ -18,7 +18,6 @@
 
 with Ada.Unchecked_Deallocation;
 
-with Types; use Types;
 with Tables;
 
 with Vhdl.Errors; use Vhdl.Errors;
@@ -55,6 +54,7 @@ package body Elab.Vhdl_Context is
                                  Uninst_Scope => null,
                                  Source_Scope => Null_Node,
                                  Config       => Null_Node,
+                                 Foreign      => 0,
                                  Extra_Units  => null,
                                  Extra_Link   => null,
                                  Elab_Objects => 0,
@@ -74,6 +74,7 @@ package body Elab.Vhdl_Context is
    is
       Info : constant Sim_Info_Acc := Get_Info (Blk);
       Scope : Sim_Info_Acc;
+      Nbr_Objs : Object_Slot_Type;
       Res : Synth_Instance_Acc;
    begin
       if Get_Kind (Blk) = Iir_Kind_Architecture_Body then
@@ -83,7 +84,15 @@ package body Elab.Vhdl_Context is
          Scope := Info;
       end if;
 
-      Res := new Synth_Instance_Type'(Max_Objs => Info.Nbr_Objects,
+      if Scope = null then
+         --  Foreign modules are not annotated.
+         pragma Assert (Get_Kind (Blk) = Iir_Kind_Foreign_Module);
+         Nbr_Objs := 0;
+      else
+         Nbr_Objs := Info.Nbr_Objects;
+      end if;
+
+      Res := new Synth_Instance_Type'(Max_Objs => Nbr_Objs,
                                       Is_Const => False,
                                       Is_Error => False,
                                       Id => Inst_Tables.Last + 1,
@@ -92,6 +101,7 @@ package body Elab.Vhdl_Context is
                                       Uninst_Scope => null,
                                       Source_Scope => Blk,
                                       Config       => Config,
+                                      Foreign      => 0,
                                       Extra_Units  => null,
                                       Extra_Link   => null,
                                       Elab_Objects => 0,
@@ -131,6 +141,7 @@ package body Elab.Vhdl_Context is
                                       Uninst_Scope => null,
                                       Source_Scope => Blk,
                                       Config       => Config,
+                                      Foreign      => 0,
                                       Extra_Units  => null,
                                       Extra_Link   => null,
                                       Elab_Objects => 0,
@@ -201,6 +212,17 @@ package body Elab.Vhdl_Context is
       return Inst.Config;
    end Get_Instance_Config;
 
+   procedure Set_Instance_Foreign (Inst : Synth_Instance_Acc; N : Int32) is
+   begin
+      pragma Assert (Inst.Foreign = 0);
+      Inst.Foreign := N;
+   end Set_Instance_Foreign;
+
+   function Get_Instance_Foreign (Inst : Synth_Instance_Acc) return Int32 is
+   begin
+      return Inst.Foreign;
+   end Get_Instance_Foreign;
+
    procedure Add_Extra_Instance (Inst : Synth_Instance_Acc;
                                  Extra : Synth_Instance_Acc) is
    begin
diff --git a/src/synth/elab-vhdl_context.ads b/src/synth/elab-vhdl_context.ads
index 2fc483c7f..8924da120 100644
--- a/src/synth/elab-vhdl_context.ads
+++ b/src/synth/elab-vhdl_context.ads
@@ -16,6 +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 Vhdl.Annotations; use Vhdl.Annotations;
 with Vhdl.Nodes; use Vhdl.Nodes;
 
@@ -80,6 +82,9 @@ package Elab.Vhdl_Context is
    procedure Set_Instance_Config (Inst : Synth_Instance_Acc; Config : Node);
    function Get_Instance_Config (Inst : Synth_Instance_Acc) return Node;
 
+   procedure Set_Instance_Foreign (Inst : Synth_Instance_Acc; N : Int32);
+   function Get_Instance_Foreign (Inst : Synth_Instance_Acc) return Int32;
+
    --  Add/Get extra instances.
    --  Those instances are verification units.
    procedure Add_Extra_Instance (Inst : Synth_Instance_Acc;
@@ -209,6 +214,7 @@ private
 
       --  Block configuration (unless the instance is for a package).
       Config : Node;
+      Foreign : Int32;
 
       --  Chain of verification units that applies to this one.
       Extra_Units : Synth_Instance_Acc;
diff --git a/src/synth/elab-vhdl_insts.adb b/src/synth/elab-vhdl_insts.adb
index f97b4335b..19b02a745 100644
--- a/src/synth/elab-vhdl_insts.adb
+++ b/src/synth/elab-vhdl_insts.adb
@@ -629,8 +629,11 @@ package body Elab.Vhdl_Insts is
       end case;
 
       if Get_Kind (Ent) = Iir_Kind_Foreign_Module then
-         --  TODO.
-         raise Internal_Error;
+         Sub_Inst := Make_Elab_Instance (Comp_Inst, Ent, Null_Node);
+         Create_Component_Instance (Comp_Inst, Sub_Inst);
+
+         Elab_Foreign_Instance (Sub_Inst, Comp_Inst, Bind, Ent);
+         return;
       end if;
 
       if Arch = Null_Node then
diff --git a/src/synth/elab-vhdl_insts.ads b/src/synth/elab-vhdl_insts.ads
index 3c34fa4ed..b85b3d23a 100644
--- a/src/synth/elab-vhdl_insts.ads
+++ b/src/synth/elab-vhdl_insts.ads
@@ -33,4 +33,11 @@ package Elab.Vhdl_Insts is
    --  The synthesis of BLK will clear all configuration of it.
    procedure Apply_Block_Configuration (Cfg : Node; Blk : Node);
 
+   type Elab_Foreign_Instance_Acc is access
+     procedure (Syn_Inst : Synth_Instance_Acc;
+                Comp_Inst : Synth_Instance_Acc;
+                Bind : Node;
+                Module : Node);
+
+   Elab_Foreign_Instance : Elab_Foreign_Instance_Acc;
 end Elab.Vhdl_Insts;
diff --git a/src/synth/synth-environment.adb b/src/synth/synth-environment.adb
index 7b5eb5c50..b0bf4d6dd 100644
--- a/src/synth/synth-environment.adb
+++ b/src/synth/synth-environment.adb
@@ -93,6 +93,18 @@ package body Synth.Environment is
       Wire_Id_Table.Table (Wid).Gate := Gate;
    end Set_Wire_Gate;
 
+   procedure Replace_Wire_Gate (Wid : Wire_Id; Gate : Net)
+   is
+      Old : constant Net := Wire_Id_Table.Table (Wid).Gate;
+      Inst : constant Instance := Get_Net_Parent (Old);
+   begin
+      Redirect_Inputs (Old, Gate);
+      Remove_Instance (Inst);
+      Set_Location (Get_Net_Parent (Gate), Get_Location (Inst));
+      --  FIXME: attributes ?
+      Wire_Id_Table.Table (Wid).Gate := Gate;
+   end Replace_Wire_Gate;
+
    function Get_Wire_Gate (Wid : Wire_Id) return Net is
    begin
       return Wire_Id_Table.Table (Wid).Gate;
diff --git a/src/synth/synth-environment.ads b/src/synth/synth-environment.ads
index 945642821..604ca0caf 100644
--- a/src/synth/synth-environment.ads
+++ b/src/synth/synth-environment.ads
@@ -120,6 +120,7 @@ package Synth.Environment is
    --  Set the gate for a wire.
    procedure Set_Wire_Gate (Wid : Wire_Id; Gate : Net);
    function Get_Wire_Gate (Wid : Wire_Id) return Net;
+   procedure Replace_Wire_Gate (Wid : Wire_Id; Gate : Net);
 
    --  The current value of WID.  For variables, this is the last assigned
    --  value.  For signals, this is the gate.
diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb
index 2a44d7440..7545dc9d1 100644
--- a/src/synth/synth-vhdl_insts.adb
+++ b/src/synth/synth-vhdl_insts.adb
@@ -18,7 +18,6 @@
 
 with GNAT.SHA1;
 
-with Types; use Types;
 with Types_Utils; use Types_Utils;
 with Name_Table;
 with Std_Names;
@@ -1110,6 +1109,8 @@ package body Synth.Vhdl_Insts is
       Inst_Obj : Inst_Object;
       Inst : Instance;
       Inst_Name : Sname;
+
+      M : Module;
    begin
       pragma Assert (Get_Kind (Aspect) = Iir_Kind_Entity_Aspect_Entity);
 
@@ -1158,37 +1159,43 @@ package body Synth.Vhdl_Insts is
 
       Sub_Inst := Get_Component_Instance (Comp_Inst);
       Arch := Get_Source_Scope (Sub_Inst);
-      Ent := Get_Entity (Arch);
       Sub_Config := Get_Instance_Config (Sub_Inst);
+      if Get_Kind (Arch) = Iir_Kind_Foreign_Module then
+         M := Synth_Foreign_Module
+           (Global_Base_Instance, Get_Instance_Foreign (Sub_Inst),
+            Sub_Inst, Arch);
 
-      if Get_Kind (Ent) = Iir_Kind_Foreign_Module then
-         --  TODO.
-         raise Internal_Error;
+         Inst := New_Instance (Get_Instance_Module (Syn_Inst), M, Inst_Name);
+         Set_Location (Inst, Stmt);
+      else
+         Ent := Get_Entity (Arch);
+
+         --  Elaborate generic + map aspect for the entity instance.
+         Set_Extra (Sub_Inst, Comp_Inst,
+                    New_Sname_User (Get_Identifier (Ent), No_Sname));
+
+         --  Search if corresponding module has already been used.
+         --  If not create a new module
+         --   * create a name from the generics and the library
+         --   * create inputs/outputs
+         --   * add it to the list of module to be synthesized.
+         Inst_Obj := Interning_Get ((Decl => Ent,
+                                     Arch => Arch,
+                                     Config => Sub_Config,
+                                     Syn_Inst => Sub_Inst,
+                                     Encoding => Name_Hash));
+
+         --  TODO: free sub_inst.
+
+         Inst := New_Instance (Get_Instance_Module (Syn_Inst),
+                               Inst_Obj.M, Inst_Name);
+         Set_Location (Inst, Stmt);
+
+         Synth_Instantiate_Module
+           (Comp_Inst, Inst, Inst_Obj, Get_Port_Map_Aspect_Chain (Bind));
       end if;
 
-      --  Elaborate generic + map aspect for the entity instance.
-      Set_Extra (Sub_Inst,
-                 Comp_Inst, New_Sname_User (Get_Identifier (Ent), No_Sname));
-
-      --  Search if corresponding module has already been used.
-      --  If not create a new module
-      --   * create a name from the generics and the library
-      --   * create inputs/outputs
-      --   * add it to the list of module to be synthesized.
-      Inst_Obj := Interning_Get ((Decl => Ent,
-                                  Arch => Arch,
-                                  Config => Sub_Config,
-                                  Syn_Inst => Sub_Inst,
-                                  Encoding => Name_Hash));
-
-      --  TODO: free sub_inst.
-
-      Inst := New_Instance (Get_Instance_Module (Syn_Inst),
-                            Inst_Obj.M, Inst_Name);
-      Set_Location (Inst, Stmt);
-
-      Synth_Instantiate_Module
-        (Comp_Inst, Inst, Inst_Obj, Get_Port_Map_Aspect_Chain (Bind));
+      pragma Unreferenced (M);
 
       --  Connect out from component to instance.
       --  Instantiate the module
diff --git a/src/synth/synth-vhdl_insts.ads b/src/synth/synth-vhdl_insts.ads
index ae7fd715d..5654c6476 100644
--- a/src/synth/synth-vhdl_insts.ads
+++ b/src/synth/synth-vhdl_insts.ads
@@ -16,6 +16,9 @@
 --  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 Netlists;
+
 with Elab.Vhdl_Context; use Elab.Vhdl_Context;
 
 with Vhdl.Nodes; use Vhdl.Nodes;
@@ -40,4 +43,12 @@ package Synth.Vhdl_Insts is
 
    procedure Synth_Component_Instantiation_Statement
      (Syn_Inst : Synth_Instance_Acc; Stmt : Node);
+
+   type Synth_Foreign_Module_Acc is access
+     function (Base : Base_Instance_Acc;
+               M : Int32;
+               Vhdl_Inst : Synth_Instance_Acc;
+               Vhdl_Decl : Node) return Netlists.Module;
+
+   Synth_Foreign_Module : Synth_Foreign_Module_Acc;
 end Synth.Vhdl_Insts;
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index 8a2f3de67..310a30a59 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -54,6 +54,10 @@ package body Synthesis is
    begin
       Base := Make_Base_Instance;
 
+      if Synth_Initialize_Foreign /= null then
+         Synth_Initialize_Foreign.all;
+      end if;
+
       Unit := Get_Library_Unit (Design);
       if Get_Kind (Unit) = Iir_Kind_Foreign_Module then
          if Synth_Top_Foreign = null then
diff --git a/src/synth/synthesis.ads b/src/synth/synthesis.ads
index 30523c21d..4b8ea86b8 100644
--- a/src/synth/synthesis.ads
+++ b/src/synth/synthesis.ads
@@ -40,5 +40,8 @@ package Synthesis is
      (Base : Base_Instance_Acc; Unit : Int32; Encoding : Name_Encoding);
    Synth_Top_Foreign : Synth_Top_Acc;
 
+   type Synth_Initialize_Acc is access procedure;
+   Synth_Initialize_Foreign : Synth_Initialize_Acc;
+
    Synth_Error : exception;
 end Synthesis;