synth: add synth_top_entity.

3 files changed, 96 insertions, 221 deletions

diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index 5bffaacbf..3201f7254 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -18,17 +18,20 @@
 --  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
 --  MA 02110-1301, USA.
 
+with Types; use Types;
 with Libraries;
 with Hash; use Hash;
 with Interning;
 with Synthesis; use Synthesis;
 
+with Netlists; use Netlists;
 with Netlists.Builders;
 with Netlists.Utils;
 
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Annotations; use Vhdl.Annotations;
 
+with Synth.Values; use Synth.Values;
 with Synth.Environment; use Synth.Environment;
 with Synth.Stmts; use Synth.Stmts;
 with Synth.Decls; use Synth.Decls;
@@ -36,6 +39,31 @@ with Synth.Types; use Synth.Types;
 with Synth.Expr; use Synth.Expr;
 
 package body Synth.Insts is
+   function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is
+   begin
+      case Mode is
+         when Iir_In_Mode =>
+            return Port_In;
+         when Iir_Buffer_Mode
+           | Iir_Out_Mode
+           | Iir_Inout_Mode =>
+            return Port_Out;
+         when Iir_Linkage_Mode
+           | Iir_Unknown_Mode =>
+            raise Synth_Error;
+      end case;
+   end Mode_To_Port_Kind;
+
+   function Get_Nbr_Wire (Val : Value_Acc) return Uns32 is
+   begin
+      case Val.Kind is
+         when Value_Wire =>
+            return 1;
+         when others =>
+            raise Internal_Error;  --  TODO
+      end case;
+   end Get_Nbr_Wire;
+
    procedure Make_Port_Desc (Val : Value_Acc;
                              Name : Sname;
                              Wd : Width;
@@ -201,31 +229,6 @@ package body Synth.Insts is
       Build => Build,
       Equal => Equal);
 
-   function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is
-   begin
-      case Mode is
-         when Iir_In_Mode =>
-            return Port_In;
-         when Iir_Buffer_Mode
-           | Iir_Out_Mode
-           | Iir_Inout_Mode =>
-            return Port_Out;
-         when Iir_Linkage_Mode
-           | Iir_Unknown_Mode =>
-            raise Synth_Error;
-      end case;
-   end Mode_To_Port_Kind;
-
-   function Get_Nbr_Wire (Val : Value_Acc) return Uns32 is
-   begin
-      case Val.Kind is
-         when Value_Wire =>
-            return 1;
-         when others =>
-            raise Internal_Error;  --  TODO
-      end case;
-   end Get_Nbr_Wire;
-
    procedure Synth_Design_Instantiation_Statement
      (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
    is
@@ -379,6 +382,72 @@ package body Synth.Insts is
       raise Internal_Error;
    end Synth_Component_Instantiation_Statement;
 
+   procedure Synth_Top_Entity (Arch : Node)
+   is
+      Config : constant Node := Null_Node; --  FIXME
+      Entity : constant Node := Get_Entity (Arch);
+      Syn_Inst : Synth_Instance_Acc;
+      Inter : Node;
+      Nbr_Inputs : Port_Nbr;
+      Nbr_Outputs : Port_Nbr;
+      Num : Uns32;
+      Inst_Obj : Inst_Object;
+   begin
+      Syn_Inst := Make_Instance (Global_Instance, Get_Info (Arch));
+      Syn_Inst.Block_Scope := Get_Info (Entity);
+      Syn_Inst.Name := New_Sname_User (Get_Identifier (Entity));
+
+      --  Compute generics.
+      Inter := Get_Generic_Chain (Entity);
+      while Is_Valid (Inter) loop
+         Synth_Declaration_Type (Syn_Inst, Inter);
+         declare
+            Val : Value_Acc;
+         begin
+            Val := Synth_Expression_With_Type
+              (Syn_Inst, Get_Default_Value (Inter), Get_Type (Inter));
+            Create_Object (Syn_Inst, Inter, Val);
+         end;
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      --  Elaborate port types.
+      --  FIXME: what about unconstrained ports ?  Get the type from the
+      --    association.
+      Inter := Get_Port_Chain (Entity);
+      Nbr_Inputs := 0;
+      Nbr_Outputs := 0;
+      while Is_Valid (Inter) loop
+         if not Is_Fully_Constrained_Type (Get_Type (Inter)) then
+            --  TODO
+            raise Internal_Error;
+         end if;
+         Synth_Declaration_Type (Syn_Inst, Inter);
+         case Mode_To_Port_Kind (Get_Mode (Inter)) is
+            when Port_In =>
+               Make_Object (Syn_Inst, Wire_None, Inter);
+               Num := Get_Nbr_Wire (Get_Value (Syn_Inst, Inter));
+               Nbr_Inputs := Nbr_Inputs + Port_Nbr (Num);
+            when Port_Out
+              | Port_Inout =>
+               Make_Object (Syn_Inst, Wire_None, Inter);
+               Num := Get_Nbr_Wire (Get_Value (Syn_Inst, Inter));
+               Nbr_Outputs := Nbr_Outputs + Port_Nbr (Num);
+         end case;
+         Inter := Get_Chain (Inter);
+      end loop;
+
+      --  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 := Insts_Interning.Get ((Arch => Arch,
+                                        Config => Config,
+                                        Syn_Inst => Syn_Inst));
+      pragma Unreferenced (Inst_Obj);
+   end Synth_Top_Entity;
+
    procedure Create_Input_Wire (Self_Inst : Instance;
                                 Inter : Node;
                                 Idx : in out Port_Idx;
diff --git a/src/synth/synth-insts.ads b/src/synth/synth-insts.ads
index 4c4c8ca81..39235c0d2 100644
--- a/src/synth/synth-insts.ads
+++ b/src/synth/synth-insts.ads
@@ -18,19 +18,15 @@
 --  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
 --  MA 02110-1301, USA.
 
-with Types; use Types;
-with Netlists; use Netlists;
 with Vhdl.Nodes; use Vhdl.Nodes;
 
-with Synth.Values; use Synth.Values;
 with Synth.Context; use Synth.Context;
 
 package Synth.Insts is
    procedure Init;
    procedure Synth_All_Instances;
 
-   function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind;
-   function Get_Nbr_Wire (Val : Value_Acc) return Uns32;
+   procedure Synth_Top_Entity (Arch : Node);
 
    procedure Synth_Design_Instantiation_Statement
      (Syn_Inst : Synth_Instance_Acc; Stmt : Node);
diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb
index 222d8a0fe..d3aba58fc 100644
--- a/src/synth/synthesis.adb
+++ b/src/synth/synthesis.adb
@@ -18,22 +18,16 @@
 --  Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
 --  MA 02110-1301, USA.
 
-with Types; use Types;
 with Name_Table; use Name_Table;
 
 with Netlists.Builders; use Netlists.Builders;
-with Netlists.Utils;
 
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Annotations; use Vhdl.Annotations;
 
-with Synth.Environment; use Synth.Environment;
 with Synth.Values; use Synth.Values;
 with Synth.Context; use Synth.Context;
-with Synth.Types; use Synth.Types;
 with Synth.Decls; use Synth.Decls;
-with Synth.Stmts; use Synth.Stmts;
-with Synth.Expr; use Synth.Expr;
 with Synth.Insts; use Synth.Insts;
 
 with Synth.Environment.Debug;
@@ -43,189 +37,6 @@ with Errorout; use Errorout;
 with Vhdl.Errors; use Vhdl.Errors;
 
 package body Synthesis is
-   procedure Make_Port_Desc (Val : Value_Acc;
-                             Name : Sname;
-                             Wd : Width;
-                             Ports : in out Port_Desc_Array;
-                             Idx : in out Port_Nbr;
-                             Dir : Port_Kind)
-   is
-   begin
-      case Val.Kind is
-         when Value_Wire =>
-            Idx := Idx + 1;
-            Ports (Idx) := (Name => Name,
-                            W => Wd,
-                            Dir => Dir,
-                            Left | Right => 0);
-         when others =>
-            raise Internal_Error; --  TODO
-      end case;
-   end Make_Port_Desc;
-
-   procedure Make_Port_Desc (Syn_Inst : Synth_Instance_Acc;
-                             Inter : Node;
-                             Ports : in out Port_Desc_Array;
-                             Idx : in out Port_Nbr;
-                             Dir : Port_Kind)
-   is
-      Val : constant Value_Acc := Get_Value (Syn_Inst, Inter);
-      Wd : constant Width := Get_Width (Syn_Inst, Get_Type (Inter));
-      Name : Sname;
-   begin
-      Name :=  New_Sname_User (Get_Identifier (Inter));
-      Make_Port_Desc (Val, Name, Wd, Ports, Idx, Dir);
-   end Make_Port_Desc;
-
-   procedure Create_Input_Wire
-     (Self_Inst : Instance; Idx : in out Port_Idx; Val : Value_Acc) is
-   begin
-      case Val.Kind is
-         when Value_Wire =>
-            Wire_Id_Table.Table (Val.W).Gate := Get_Output (Self_Inst, Idx);
-            Idx := Idx + 1;
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Create_Input_Wire;
-
-   procedure Create_Output_Wire
-     (Self_Inst : Instance; Idx : in out Port_Idx; Val : Value_Acc)
-   is
-      Value : Net;
-      Inp : Input;
-      W : Width;
-   begin
-      case Val.Kind is
-         when Value_Wire =>
-            --  Create a gate for the output, so that it could be read.
-            W := Get_Output_Desc (Get_Module (Self_Inst), Idx).W;
-            Value := Build_Output (Build_Context, W);
-            Inp := Get_Input (Self_Inst, Idx);
-            Connect (Inp, Value);
-            Wire_Id_Table.Table (Val.W).Gate := Value;
-            Idx := Idx + 1;
-         when others =>
-            raise Internal_Error;
-      end case;
-   end Create_Output_Wire;
-
-   function Synth_Entity
-     (Parent_Module : Module; Parent_Inst : Synth_Instance_Acc; Arch : Node)
-     return Synth_Instance_Acc
-   is
-      Entity : constant Node := Get_Entity (Arch);
-      Syn_Inst : Synth_Instance_Acc;
-      Self_Inst : Instance;
-      Inter : Node;
-      Nbr_Inputs : Port_Nbr;
-      Nbr_Outputs : Port_Nbr;
-      Num : Uns32;
-   begin
-      Syn_Inst := Make_Instance (Parent_Inst, Get_Info (Arch));
-      Syn_Inst.Block_Scope := Get_Info (Entity);
-      Syn_Inst.Name := New_Sname_User (Get_Identifier (Entity));
-
-      --  Compute generics.
-      Inter := Get_Generic_Chain (Entity);
-      while Is_Valid (Inter) loop
-         Synth_Declaration_Type (Syn_Inst, Inter);
-         declare
-            Val : Value_Acc;
-         begin
-            Val := Synth_Expression_With_Type
-              (Syn_Inst, Get_Default_Value (Inter), Get_Type (Inter));
-            Create_Object (Syn_Inst, Inter, Val);
-         end;
-         Inter := Get_Chain (Inter);
-      end loop;
-
-      --  Allocate values and count inputs and outputs
-      Inter := Get_Port_Chain (Entity);
-      Nbr_Inputs := 0;
-      Nbr_Outputs := 0;
-      while Is_Valid (Inter) loop
-         Synth_Declaration_Type (Syn_Inst, Inter);
-         case Mode_To_Port_Kind (Get_Mode (Inter)) is
-            when Port_In =>
-               Make_Object (Syn_Inst, Wire_Input, Inter);
-               Num := Get_Nbr_Wire (Get_Value (Syn_Inst, Inter));
-               Nbr_Inputs := Nbr_Inputs + Port_Nbr (Num);
-            when Port_Out
-              | Port_Inout =>
-               Make_Object (Syn_Inst, Wire_Output, Inter);
-               Num := Get_Nbr_Wire (Get_Value (Syn_Inst, Inter));
-               Nbr_Outputs := Nbr_Outputs + Port_Nbr (Num);
-         end case;
-         Inter := Get_Chain (Inter);
-      end loop;
-
-      --  Declare module.
-      Syn_Inst.M := New_User_Module
-        (Parent_Module, New_Sname_User (Get_Identifier (Entity)),
-         Id_User_None, Nbr_Inputs, Nbr_Outputs, 0);
-
-      --  Add ports to module.
-      declare
-         Inports : Port_Desc_Array (1 .. Nbr_Inputs);
-         Outports : Port_Desc_Array (1 .. Nbr_Outputs);
-      begin
-         Inter := Get_Port_Chain (Entity);
-         Nbr_Inputs := 0;
-         Nbr_Outputs := 0;
-         while Is_Valid (Inter) loop
-            case Mode_To_Port_Kind (Get_Mode (Inter)) is
-               when Port_In =>
-                  Make_Port_Desc
-                    (Syn_Inst, Inter, Inports, Nbr_Inputs, Port_In);
-               when Port_Out
-                 | Port_Inout =>
-                  Make_Port_Desc
-                    (Syn_Inst, Inter, Outports, Nbr_Outputs, Port_Out);
-            end case;
-            Inter := Get_Chain (Inter);
-         end loop;
-         pragma Assert (Nbr_Inputs = Inports'Last);
-         pragma Assert (Nbr_Outputs = Outports'Last);
-         Set_Port_Desc (Syn_Inst.M, Inports, Outports);
-      end;
-
-      Self_Inst := Create_Self_Instance (Syn_Inst.M);
-      Set_Parent (Build_Context, Syn_Inst.M);
-
-      --  Create wires for inputs and outputs.
-      Inter := Get_Port_Chain (Entity);
-      Nbr_Inputs := 0;
-      Nbr_Outputs := 0;
-      while Is_Valid (Inter) loop
-         case Mode_To_Port_Kind (Get_Mode (Inter)) is
-            when Port_In =>
-               Create_Input_Wire
-                 (Self_Inst, Nbr_Inputs, Get_Value (Syn_Inst, Inter));
-            when Port_Out
-              | Port_Inout =>
-               Create_Output_Wire
-                 (Self_Inst, Nbr_Outputs, Get_Value (Syn_Inst, Inter));
-         end case;
-         Inter := Get_Chain (Inter);
-      end loop;
-
-      Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
-      Synth_Concurrent_Statements
-        (Syn_Inst, Get_Concurrent_Statement_Chain (Entity));
-
-      Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
-      Synth_Concurrent_Statements
-        (Syn_Inst, Get_Concurrent_Statement_Chain (Arch));
-
-      --  Remove unused gates.  This is not only an optimization but also
-      --  a correctness point: there might be some unsynthesizable gates, like
-      --  the one created for 'rising_egde (clk) and not rst'.
-      Netlists.Utils.Remove_Unused_Instances (Syn_Inst.M);
-
-      return Syn_Inst;
-   end Synth_Entity;
-
    procedure Synth_Dependencies (Parent_Inst : Synth_Instance_Acc; Unit : Node)
    is
       Dep_List : constant Node_List := Get_Dependence_List (Unit);
@@ -308,8 +119,7 @@ package body Synthesis is
       Synth_Dependencies
         (Global_Instance, Get_Design_Unit (Arch));
 
-      Syn_Inst := Synth_Entity (Global_Module, Global_Instance, Arch);
-
+      Synth_Top_Entity (Arch);
       Synth_All_Instances;
       if Errorout.Nbr_Errors > 0 then
          raise Compilation_Error;