synth: preliminary work to export module parameters.

9 files changed, 321 insertions, 26 deletions

diff --git a/src/synth/ghdlsynth_gates.h b/src/synth/ghdlsynth_gates.h
index aa4053010..e22aa4713 100644
--- a/src/synth/ghdlsynth_gates.h
+++ b/src/synth/ghdlsynth_gates.h
@@ -5,7 +5,8 @@ enum Module_Id {
    Id_Free = 1,
    Id_Design = 2,
    Id_User_None  = 128,
-   Id_User_First = Id_User_None + 1,
+   Id_User_Parameters = 129,
+   Id_User_First = Id_User_Parameters + 1,
    Id_And  = 3,
    Id_Or   = 4,
    Id_Xor  = 5,
diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb
index 3cb08bd28..957d1a3d0 100644
--- a/src/synth/netlists-disp_vhdl.adb
+++ b/src/synth/netlists-disp_vhdl.adb
@@ -154,6 +154,20 @@ package body Netlists.Disp_Vhdl is
       end;
    end Disp_Net_Name;
 
+   Bchar : constant array (Uns32 range 0 .. 3) of Character := "01ZX";
+
+   procedure Disp_Binary_Digit (Va : Uns32; Zx : Uns32; I : Natural) is
+   begin
+      Put (Bchar (((Va / 2**I) and 1) + ((Zx / 2**I) and 1) * 2));
+   end Disp_Binary_Digit;
+
+   procedure Disp_Binary_Digits (Va : Uns32; Zx : Uns32; W : Natural) is
+   begin
+      for I in 1 .. W loop
+         Disp_Binary_Digit (Va, Zx, W - I);
+      end loop;
+   end Disp_Binary_Digits;
+
    procedure Disp_Instance_Gate (Inst : Instance)
    is
       Imod : constant Module := Get_Module (Inst);
@@ -161,6 +175,7 @@ package body Netlists.Disp_Vhdl is
       Max_Idx : Port_Idx;
       Name : Sname;
       First : Boolean;
+      Param : Param_Desc;
    begin
       Put ("  ");
       Name := Get_Instance_Name (Inst);
@@ -185,13 +200,37 @@ package body Netlists.Disp_Vhdl is
       if Get_Nbr_Params (Imod) /= 0 then
          Put_Line (" generic map (");
          for P in 1 .. Get_Nbr_Params (Inst) loop
+            Param := Get_Param_Desc (Imod, P - 1);
             if P > 1 then
                Put_Line (",");
             end if;
             Put ("    ");
-            Put_Interface_Name (Get_Param_Desc (Imod, P - 1).Name);
+            Put_Interface_Name (Param.Name);
             Put (" => ");
-            Put_Uns32 (Get_Param_Uns32 (Inst, P - 1));
+            case Param.Typ is
+               when Param_Uns32 =>
+                  Put_Uns32 (Get_Param_Uns32 (Inst, P - 1));
+               when Param_Types_Pval =>
+                  declare
+                     Pv : constant Pval := Get_Param_Pval (Inst, P - 1);
+                     Len : constant Uns32 := Get_Pval_Length (Pv);
+                     V : Logic_32;
+                     Off : Uns32;
+                  begin
+                     Put ('"');
+                     V := Read_Pval (Pv, 0);
+                     for I in reverse 0 .. Len - 1 loop
+                        Off := I mod 32;
+                        if Off = 31 then
+                           V := Read_Pval (Pv, I / 32);
+                        end if;
+                        Disp_Binary_Digit (V.Val, V.Zx, Natural (Off));
+                     end loop;
+                     Put ('"');
+                  end;
+               when Param_Invalid =>
+                  Put ("*invalid*");
+            end case;
          end loop;
          Put_Line (")");
          Put_Line ("    port map (");
@@ -243,8 +282,6 @@ package body Netlists.Disp_Vhdl is
       Put_Line (");");
    end Disp_Instance_Gate;
 
-   Bchar : constant array (Uns32 range 0 .. 3) of Character := "01ZX";
-
    function Get_Lit_Quote (Wd : Width) return Character is
    begin
       if Wd = 1 then
@@ -254,14 +291,6 @@ package body Netlists.Disp_Vhdl is
       end if;
    end Get_Lit_Quote;
 
-   procedure Disp_Binary_Digits (Va : Uns32; Zx : Uns32; W : Natural) is
-   begin
-      for I in 1 .. W loop
-         Put (Bchar (((Va / 2**(W - I)) and 1)
-                     + ((Zx / 2**(W - I)) and 1) * 2));
-      end loop;
-   end Disp_Binary_Digits;
-
    procedure Disp_Binary_Lit (Va : Uns32; Zx : Uns32; Wd : Width)
    is
       Q : constant Character := Get_Lit_Quote (Wd);
diff --git a/src/synth/netlists-dump.adb b/src/synth/netlists-dump.adb
index 950fa66de..c36b4a171 100644
--- a/src/synth/netlists-dump.adb
+++ b/src/synth/netlists-dump.adb
@@ -124,6 +124,12 @@ package body Netlists.Dump is
             Put ("invalid");
          when Param_Uns32 =>
             Put_Uns32 (Get_Param_Uns32 (Inst, Idx));
+         when Param_Pval_Vector
+           | Param_Pval_String
+           | Param_Pval_Integer
+           | Param_Pval_Real
+           | Param_Pval_Time_Ps =>
+            Put ("generic");
       end case;
    end Dump_Parameter;
 
@@ -256,6 +262,16 @@ package body Netlists.Dump is
                Put ("invalid");
             when Param_Uns32 =>
                Put ("uns32");
+            when Param_Pval_Vector =>
+               Put ("pval.vector");
+            when Param_Pval_String =>
+               Put ("pval.string");
+            when Param_Pval_Integer =>
+               Put ("pval.integer");
+            when Param_Pval_Real =>
+               Put ("pval.real");
+            when Param_Pval_Time_Ps =>
+               Put ("pval.time.ps");
          end case;
          New_Line;
       end loop;
diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb
index d130b7c1f..33737bb1b 100644
--- a/src/synth/netlists.adb
+++ b/src/synth/netlists.adb
@@ -813,6 +813,24 @@ package body Netlists is
       Params_Table.Table (Get_Param_Idx (Inst, Param)) := Val;
    end Set_Param_Uns32;
 
+   function Get_Param_Pval (Inst : Instance; Param : Param_Idx) return Pval
+   is
+      M : constant Module := Get_Module (Inst);
+      pragma Assert (Param < Get_Nbr_Params (Inst));
+      pragma Assert (Get_Param_Desc (M, Param).Typ in Param_Types_Pval);
+   begin
+      return Pval (Params_Table.Table (Get_Param_Idx (Inst, Param)));
+   end Get_Param_Pval;
+
+   procedure Set_Param_Pval (Inst : Instance; Param : Param_Idx; Val : Pval)
+   is
+      M : constant Module := Get_Module (Inst);
+      pragma Assert (Param < Get_Nbr_Params (Inst));
+      pragma Assert (Get_Param_Desc (M, Param).Typ in Param_Types_Pval);
+   begin
+      Params_Table.Table (Get_Param_Idx (Inst, Param)) := Uns32 (Val);
+   end Set_Param_Pval;
+
    procedure Connect (I : Input; O : Net)
    is
       pragma Assert (Is_Valid (I));
@@ -892,6 +910,91 @@ package body Netlists is
       Nets_Table.Table (Old).First_Sink := No_Input;
    end Redirect_Inputs;
 
+   type Pval_Record is record
+      Len : Uns32;
+      Va_Idx : Uns32;
+      Zx_Idx : Uns32;
+   end record;
+
+   package Pval_Table is new Tables
+     (Table_Component_Type => Pval_Record,
+      Table_Index_Type => Pval,
+      Table_Low_Bound => 0,
+      Table_Initial => 32);
+
+   package Pval_Word_Table is new Tables
+     (Table_Component_Type => Uns32,
+      Table_Index_Type => Uns32,
+      Table_Low_Bound => 0,
+      Table_Initial => 32);
+
+   function Create_Pval4 (Len : Uns32) return Pval
+   is
+      pragma Assert (Len > 0);
+      Nwords : constant Uns32 := (Len + 31) / 32;
+      Idx : constant Uns32 := Pval_Word_Table.Last + 1;
+      Res : Uns32;
+   begin
+      Pval_Table.Append ((Len => Len,
+                          Va_Idx => Idx,
+                          Zx_Idx => Idx + Nwords));
+      Res := Pval_Word_Table.Allocate (Natural (2 * Nwords));
+      pragma Assert (Res = Idx);
+      return Pval_Table.Last;
+   end Create_Pval4;
+
+   function Create_Pval2 (Len : Uns32) return Pval
+   is
+      pragma Assert (Len > 0);
+      Nwords : constant Uns32 := (Len + 31) / 32;
+      Idx : constant Uns32 := Pval_Word_Table.Last + 1;
+      Res : Uns32;
+   begin
+      Pval_Table.Append ((Len => Len,
+                          Va_Idx => Idx,
+                          Zx_Idx => 0));
+      Res := Pval_Word_Table.Allocate (Natural (Nwords));
+      pragma Assert (Res = Idx);
+      return Pval_Table.Last;
+   end Create_Pval2;
+
+   function Get_Pval_Length (P : Pval) return Uns32
+   is
+      pragma Assert (P <= Pval_Table.Last);
+   begin
+      return Pval_Table.Table (P).Len;
+   end Get_Pval_Length;
+
+   function Read_Pval (P : Pval; Off : Uns32) return Logic_32
+   is
+      pragma Assert (P <= Pval_Table.Last);
+      Pval_Rec : Pval_Record renames Pval_Table.Table (P);
+      pragma Assert (Off <= (Pval_Rec.Len - 1) / 32);
+      Res : Logic_32;
+   begin
+      Res.Val := Pval_Word_Table.Table (Pval_Rec.Va_Idx + Off);
+      if Pval_Rec.Zx_Idx = 0 then
+         Res.Zx := 0;
+      else
+         Res.Zx := Pval_Word_Table.Table (Pval_Rec.Zx_Idx + Off);
+      end if;
+      return Res;
+   end Read_Pval;
+
+   procedure Write_Pval (P : Pval; Off : Uns32; Val : Logic_32)
+   is
+      pragma Assert (P <= Pval_Table.Last);
+      Pval_Rec : Pval_Record renames Pval_Table.Table (P);
+      pragma Assert (Off <= (Pval_Rec.Len - 1) / 32);
+   begin
+      Pval_Word_Table.Table (Pval_Rec.Va_Idx + Off) := Val.Val;
+      if Pval_Rec.Zx_Idx = 0 then
+         pragma Assert (Val.Zx = 0);
+         null;
+      else
+         Pval_Word_Table.Table (Pval_Rec.Zx_Idx + Off) := Val.Zx;
+      end if;
+   end Write_Pval;
 begin
    --  Initialize snames_table: create the first entry for No_Sname.
    Snames_Table.Append ((Kind => Sname_Artificial,
@@ -963,4 +1066,11 @@ begin
 
    Params_Table.Append (0);
    pragma Assert (Params_Table.Last = No_Param_Idx);
+
+   Pval_Table.Append ((Len => 0,
+                       Va_Idx => 0,
+                       Zx_Idx => 0));
+   pragma Assert (Pval_Table.Last = No_Pval);
+
+   Pval_Word_Table.Append (0);
 end Netlists;
diff --git a/src/synth/netlists.ads b/src/synth/netlists.ads
index fb02cca17..23f369596 100644
--- a/src/synth/netlists.ads
+++ b/src/synth/netlists.ads
@@ -143,7 +143,8 @@ package Netlists is
 
    --  First id for user.
    Id_User_None  : constant Module_Id := 128;
-   Id_User_First : constant Module_Id := Id_User_None + 1;
+   Id_User_Parameters : constant Module_Id := 129;
+   Id_User_First : constant Module_Id := Id_User_Parameters + 1;
 
    --  Port index.  Starts at 0.
    type Port_Nbr is new Uns32;
@@ -171,11 +172,22 @@ package Netlists is
    type Param_Type is
      (Param_Invalid,
 
-      Param_Uns32
       --  An unsigned 32 bit value.
+      Param_Uns32,
+
+      --  A Generic value (with a hint of the type).  This is a bit/logic
+      --  vector.
+      Param_Pval_Vector,
+      Param_Pval_String,
+      Param_Pval_Integer,
+      Param_Pval_Real,
+      Param_Pval_Time_Ps
      );
    pragma Convention (C, Param_Type);
 
+   subtype Param_Types_Pval is
+     Param_Type range Param_Pval_Vector .. Param_Pval_Time_Ps;
+
    type Param_Desc is record
       --  Name of the parameter
       Name : Sname;
@@ -186,6 +198,10 @@ package Netlists is
 
    type Param_Desc_Array is array (Param_Idx range <>) of Param_Desc;
 
+   --  Parameter value.
+   type Pval is private;
+   No_Pval : constant Pval;
+
    --  Subprograms for modules.
    function New_Design (Name : Sname) return Module;
    function New_User_Module (Parent : Module;
@@ -263,6 +279,9 @@ package Netlists is
    function Get_Param_Uns32 (Inst : Instance; Param : Param_Idx) return Uns32;
    procedure Set_Param_Uns32 (Inst : Instance; Param : Param_Idx; Val : Uns32);
 
+   function Get_Param_Pval (Inst : Instance; Param : Param_Idx) return Pval;
+   procedure Set_Param_Pval (Inst : Instance; Param : Param_Idx; Val : Pval);
+
    --  Each instance has a mark flag available for any algorithm.
    --  Please leave this flag clean for the next user.
    function Get_Mark_Flag (Inst : Instance) return Boolean;
@@ -291,6 +310,16 @@ package Netlists is
    --  Reconnect all sinks of OLD to N.
    procedure Redirect_Inputs (Old : Net; N : Net);
 
+   --  For Pval.
+   --  Create a 4-state Pval.  LEN is the number of bits (cannot be 0).
+   function Create_Pval4 (Len : Uns32) return Pval;
+   --  Create a 2-state Pval.  The value cannot have X or Z.
+   function Create_Pval2 (Len : Uns32) return Pval;
+   function Get_Pval_Length (P : Pval) return Uns32;
+
+   --  OFF is the word offset, from 0 to (len - 1) / 32.
+   function Read_Pval (P : Pval; Off : Uns32) return Logic_32;
+   procedure Write_Pval (P : Pval; Off : Uns32; Val : Logic_32);
 private
    type Sname is new Uns32 range 0 .. 2**30 - 1;
    No_Sname : constant Sname := 0;
@@ -410,4 +439,8 @@ private
       First_Sink : Input;
       W : Width;
    end record;
+
+   type Pval is new Uns32;
+   No_Pval : constant Pval := 0;
+
 end Netlists;
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 66c1104c2..ed419ab76 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -122,11 +122,6 @@ package Synth.Expr is
 
    --  Conversion to logic vector.
 
-   type Logic_32 is record
-      Val : Uns32;  --  AKA aval
-      Zx  : Uns32;  --  AKA bval  (z=10, x=11)
-   end record;
-
    type Digit_Index is new Natural;
    type Logvec_Array is array (Digit_Index range <>) of Logic_32;
    type Logvec_Array_Acc is access Logvec_Array;
diff --git a/src/synth/synth-flags.ads b/src/synth/synth-flags.ads
index a3bb102e4..4f9badd1d 100644
--- a/src/synth/synth-flags.ads
+++ b/src/synth/synth-flags.ads
@@ -36,7 +36,10 @@ package Synth.Flags is
       --  but the names depend on the whole design.  So it won't be possible
       --  to do partial synthesis (ie synthesizing a sub-module, and then its
       --  parent considering the sub-module as a black-box).
-      Name_Index
+      Name_Index,
+
+      --  Use the entity name but also add parameters to the module.
+      Name_Parameters
      );
 
    Flag_Debug_Noinference : Boolean := False;
diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb
index 8acf79e24..0e4439111 100644
--- a/src/synth/synth-insts.adb
+++ b/src/synth/synth-insts.adb
@@ -41,6 +41,7 @@ with Netlists.Concats;
 with Vhdl.Utils; use Vhdl.Utils;
 with Vhdl.Errors;
 with Vhdl.Ieee.Math_Real;
+with Vhdl.Std_Package;
 
 with Synth.Values; use Synth.Values;
 with Synth.Environment; use Synth.Environment;
@@ -102,6 +103,8 @@ package body Synth.Insts is
       Config : Node;
       Syn_Inst : Synth_Instance_Acc;
       M : Module;
+      --  Encoding if the instance name.
+      Encoding : Name_Encoding;
    end record;
 
    function Hash (Params : Inst_Params) return Hash_Value_Type
@@ -320,7 +323,8 @@ package body Synth.Insts is
                Len := Len + 40;
             end if;
 
-         when Name_Asis =>
+         when Name_Asis
+           | Name_Parameters =>
             return New_Sname_User (Id, No_Sname);
 
          when Name_Index =>
@@ -343,8 +347,10 @@ package body Synth.Insts is
       Inter_Typ : Type_Acc;
       Nbr_Inputs : Port_Nbr;
       Nbr_Outputs : Port_Nbr;
+      Nbr_Params : Param_Nbr;
       Cur_Module : Module;
       Val : Value_Acc;
+      Id : Module_Id;
    begin
       if Get_Kind (Params.Decl) = Iir_Kind_Component_Declaration then
          pragma Assert (Params.Arch = Null_Node);
@@ -361,6 +367,7 @@ package body Synth.Insts is
 
       --  Copy values for generics.
       Inter := Get_Generic_Chain (Decl);
+      Nbr_Params := 0;
       while Inter /= Null_Node loop
          --  Bounds or range of the type.
          Inter_Type := Get_Subtype_Indication (Inter);
@@ -373,6 +380,7 @@ package body Synth.Insts is
                when others =>
                   null;
             end case;
+            Nbr_Params := Nbr_Params + 1;
          end if;
 
          --  Object.
@@ -409,9 +417,53 @@ package body Synth.Insts is
       --  Declare module.
       --  Build it now because it may be referenced for instantiations before
       --  being synthetized.
+      if Params.Encoding = Name_Parameters
+        and then Nbr_Params > 0
+      then
+         Id := Id_User_Parameters;
+      else
+         Id := Id_User_None;
+         Nbr_Params := 0;
+      end if;
       Cur_Module := New_User_Module (Get_Top_Module (Root_Instance),
-                                     Create_Module_Name (Params),
-                                     Id_User_None, Nbr_Inputs, Nbr_Outputs, 0);
+                                     Create_Module_Name (Params), Id,
+                                     Nbr_Inputs, Nbr_Outputs, Nbr_Params);
+
+      if Id = Id_User_Parameters then
+         declare
+            use Vhdl.Std_Package;
+            Params : Param_Desc_Array (1 .. Nbr_Params);
+            Ptype : Param_Type;
+         begin
+            Inter := Get_Generic_Chain (Decl);
+            Nbr_Params := 0;
+            while Inter /= Null_Node loop
+               --  Bounds or range of the type.
+               Inter_Type := Get_Type (Inter);
+               Inter_Type := Get_Base_Type (Inter_Type);
+               if Inter_Type = String_Type_Definition then
+                  Ptype := Param_Pval_String;
+               elsif Inter_Type = Time_Type_Definition then
+                  Ptype := Param_Pval_Time_Ps;
+               else
+                  case Get_Kind (Inter_Type) is
+                     when Iir_Kind_Integer_Type_Definition =>
+                        Ptype := Param_Pval_Integer;
+                     when Iir_Kind_Floating_Type_Definition =>
+                        Ptype := Param_Pval_Real;
+                     when others =>
+                        Ptype := Param_Pval_Vector;
+                  end case;
+               end if;
+               Nbr_Params := Nbr_Params + 1;
+               Params (Nbr_Params) :=
+                 (Name => New_Sname_User (Get_Identifier (Inter), No_Sname),
+                  Typ => Ptype);
+               Inter := Get_Chain (Inter);
+            end loop;
+            Set_Params_Desc (Cur_Module, Params);
+         end;
+      end if;
 
       --  Add ports to module.
       declare
@@ -445,7 +497,8 @@ package body Synth.Insts is
                           Arch => Arch,
                           Config => Params.Config,
                           Syn_Inst => Syn_Inst,
-                          M => Cur_Module);
+                          M => Cur_Module,
+                          Encoding => Params.Encoding);
    end Build;
 
    package Insts_Interning is new Interning
@@ -749,6 +802,43 @@ package body Synth.Insts is
          end if;
          Next_Association_Interface (Assoc, Assoc_Inter);
       end loop;
+
+      if Inst_Obj.Encoding = Name_Parameters then
+         declare
+            Inter : Node;
+            Val : Value_Acc;
+            Vec : Logvec_Array_Acc;
+            Len : Uns32;
+            Off : Uns32;
+            Has_Zx : Boolean;
+            Pv : Pval;
+            Idx : Param_Idx;
+         begin
+            Idx := 0;
+            Inter := Get_Generic_Chain (Inst_Obj.Decl);
+            while Inter /= Null_Node loop
+               Val := Get_Value (Inst_Obj.Syn_Inst, Inter);
+               Len := (Val.Typ.W + 31) / 32;
+               pragma Assert (Len > 0);
+               Vec := new Logvec_Array'(0 .. Digit_Index (Len - 1) => (0, 0));
+               Off := 0;
+               Has_Zx := False;
+               Value2logvec (Val, Vec.all, Off, Has_Zx);
+               if Has_Zx then
+                  Pv := Create_Pval4 (Val.Typ.W);
+               else
+                  Pv := Create_Pval2 (Val.Typ.W);
+               end if;
+               for I in 0 .. Len - 1 loop
+                  Write_Pval (Pv, I, Vec (Digit_Index (I)));
+               end loop;
+               Set_Param_Pval (Inst, Idx, Pv);
+
+               Inter := Get_Chain (Inter);
+               Idx := Idx + 1;
+            end loop;
+         end;
+      end if;
    end Synth_Instantiate_Module;
 
    function Synth_Port_Association_Type (Sub_Inst : Synth_Instance_Acc;
@@ -817,6 +907,7 @@ package body Synth.Insts is
       Sub_Inst : Synth_Instance_Acc;
       Inst_Obj : Inst_Object;
       Inst : Instance;
+      Enc : Name_Encoding;
    begin
       --  Elaborate generic + map aspect
       Sub_Inst := Make_Instance
@@ -831,6 +922,13 @@ package body Synth.Insts is
                                     Get_Port_Chain (Ent),
                                     Get_Port_Map_Aspect_Chain (Stmt));
 
+      --  TODO: change.
+      if True or Arch /= Null_Node then
+         Enc := Name_Hash;
+      else
+         Enc := Name_Parameters;
+      end if;
+
       --  Search if corresponding module has already been used.
       --  If not create a new module
       --   * create a name from the generics and the library
@@ -840,7 +938,7 @@ package body Synth.Insts is
                                         Arch => Arch,
                                         Config => Config,
                                         Syn_Inst => Sub_Inst,
-                                        Encoding => Name_Hash));
+                                        Encoding => Enc));
 
       --  TODO: free sub_inst.
 
diff --git a/src/types.ads b/src/types.ads
index bd63f3b87..af62cbe34 100644
--- a/src/types.ads
+++ b/src/types.ads
@@ -44,6 +44,16 @@ package Types is
    type Fp64 is new Interfaces.IEEE_Float_64;
    type Fp32 is new Interfaces.IEEE_Float_32;
 
+   --  The verilog logic type (when used in a vector).
+   --  Coding of 01zx:
+   --  For 0 and 1, ZX is 0, VAL is the bit value.
+   --  For z: ZX is 1, VAL is 0.
+   --  For x: ZX is 1, VAL is 1.
+   type Logic_32 is record
+      Val : Uns32;  --  AKA aval
+      Zx  : Uns32;  --  AKA bval
+   end record;
+
    --  Useful types.
    type String_Acc is access String;
    type String_Cst is access constant String;