From d8afbddcf37ea68a19b6edfa4820ef3bdd0c5076 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 31 Mar 2020 07:34:25 +0200 Subject: synth: preliminary work to export module parameters. --- src/synth/ghdlsynth_gates.h | 3 +- src/synth/netlists-disp_vhdl.adb | 53 ++++++++++++++----- src/synth/netlists-dump.adb | 16 ++++++ src/synth/netlists.adb | 110 +++++++++++++++++++++++++++++++++++++++ src/synth/netlists.ads | 37 ++++++++++++- src/synth/synth-expr.ads | 5 -- src/synth/synth-flags.ads | 5 +- src/synth/synth-insts.adb | 108 ++++++++++++++++++++++++++++++++++++-- src/types.ads | 10 ++++ 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; -- cgit v1.2.3