From 1e90b56431dc5df5463a760555b1abc746f50958 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 29 Jul 2019 18:44:11 +0200 Subject: synth: add support for memories. --- src/synth/netlists-builders.adb | 44 ++++++++- src/synth/netlists-builders.ads | 10 ++ src/synth/netlists-disp_vhdl.adb | 64 ++++++++++-- src/synth/netlists-dump.adb | 17 ++-- src/synth/netlists-gates.ads | 6 +- src/synth/netlists-utils.adb | 7 +- src/synth/netlists.adb | 19 +++- src/synth/synth-context.adb | 182 +++++++++++++++++++++++++++-------- src/synth/synth-decls.adb | 1 - src/synth/synth-expr.adb | 203 ++++++++++++++++++++++++--------------- src/synth/synth-expr.ads | 4 +- src/synth/synth-stmts.adb | 8 +- src/synth/synth-values.adb | 18 +++- src/synth/synth-values.ads | 12 ++- src/vhdl/vhdl-nodes.ads | 2 + 15 files changed, 445 insertions(+), 152 deletions(-) diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb index 7274fc0a6..d1c0b3785 100644 --- a/src/synth/netlists-builders.adb +++ b/src/synth/netlists-builders.adb @@ -156,6 +156,20 @@ package body Netlists.Builders is Ctxt.M_Const_Z := Res; Outputs := (0 => Create_Output ("o")); Set_Port_Desc (Res, Port_Desc_Array'(1 .. 0 => <>), Outputs); + + Res := New_User_Module + (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("const_bit")), + Id_Const_Bit, 0, 1, 0); + Ctxt.M_Const_Bit := Res; + Outputs := (0 => Create_Output ("o")); + Set_Port_Desc (Res, Port_Desc_Array'(1 .. 0 => <>), Outputs); + + Res := New_User_Module + (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("const_log")), + Id_Const_Log, 0, 1, 0); + Ctxt.M_Const_Log := Res; + Outputs := (0 => Create_Output ("o")); + Set_Port_Desc (Res, Port_Desc_Array'(1 .. 0 => <>), Outputs); end Create_Const_Modules; procedure Create_Extract_Module (Ctxt : Context_Acc) @@ -184,7 +198,7 @@ package body Netlists.Builders is begin Res := New_User_Module (Ctxt.Design, New_Sname_Artificial (Get_Identifier ("dyn_extract")), - Id_Extract, 2, 1, 2); + Id_Dyn_Extract, 2, 1, 2); Ctxt.M_Dyn_Extract := Res; Outputs := (0 => Create_Output ("o")); Inputs := (0 => Create_Input ("i"), @@ -588,6 +602,34 @@ package body Netlists.Builders is return O; end Build_Const_UL32; + function Build_Const_Bit (Ctxt : Context_Acc; W : Width) + return Instance + is + Inst : Instance; + O : Net; + begin + Inst := New_Var_Instance (Ctxt.Parent, Ctxt.M_Const_Bit, + New_Internal_Name (Ctxt), + 0, 1, Param_Idx ((W + 31) / 32)); + O := Get_Output (Inst, 0); + Set_Width (O, W); + return Inst; + end Build_Const_Bit; + + function Build_Const_Log (Ctxt : Context_Acc; W : Width) + return Instance + is + Inst : Instance; + O : Net; + begin + Inst := New_Var_Instance (Ctxt.Parent, Ctxt.M_Const_Log, + New_Internal_Name (Ctxt), + 0, 1, 2 * Param_Idx ((W + 31) / 32)); + O := Get_Output (Inst, 0); + Set_Width (O, W); + return Inst; + end Build_Const_Log; + function Build_Edge (Ctxt : Context_Acc; Src : Net) return Net is pragma Assert (Get_Width (Src) = 1); diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads index 3dbced990..8a5a0bd39 100644 --- a/src/synth/netlists-builders.ads +++ b/src/synth/netlists-builders.ads @@ -60,6 +60,14 @@ package Netlists.Builders is Xz : Uns32; W : Width) return Net; + -- Large constants. + -- Bit means only 0 or 1. + -- Log means 0/1/Z/X. Parameters 2N are aval, 2N+1 are bval. + function Build_Const_Bit (Ctxt : Context_Acc; + W : Width) return Instance; + function Build_Const_Log (Ctxt : Context_Acc; + W : Width) return Instance; + function Build_Edge (Ctxt : Context_Acc; Src : Net) return Net; function Build_Mux2 (Ctxt : Context_Acc; @@ -140,6 +148,8 @@ private M_Const_UB32 : Module; M_Const_UL32 : Module; M_Const_Z : Module; + M_Const_Bit : Module; + M_Const_Log : Module; M_Edge : Module; M_Mux2 : Module; M_Mux4 : Module; diff --git a/src/synth/netlists-disp_vhdl.adb b/src/synth/netlists-disp_vhdl.adb index f889510f3..eb86f0c6d 100644 --- a/src/synth/netlists-disp_vhdl.adb +++ b/src/synth/netlists-disp_vhdl.adb @@ -283,19 +283,40 @@ package body Netlists.Disp_Vhdl is end if; end Get_Lit_Quote; - procedure Disp_Binary_Lit (Va : Uns32; Zx : Uns32; Wd : Width) - is - W : constant Natural := Natural (Wd); - Q : constant Character := Get_Lit_Quote (Wd); + procedure Disp_Binary_Digits (Va : Uns32; Zx : Uns32; W : Natural) is begin - Put (Q); 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); + begin + Put (Q); + Disp_Binary_Digits (Va, Zx, Natural (Wd)); Put (Q); end Disp_Binary_Lit; + procedure Disp_Const_Bit (Inst : Instance) + is + W : constant Width := Get_Width (Get_Output (Inst, 0)); + Nd : constant Width := W / 32; + Ld : constant Natural := Natural (W mod 32); + begin + Put ('"'); + if Ld > 0 then + Disp_Binary_Digits (Get_Param_Uns32 (Inst, Param_Idx (Nd)), 0, Ld); + end if; + for I in reverse 1 .. Nd loop + Disp_Binary_Digits + (Get_Param_Uns32 (Inst, Param_Idx (I - 1)), 0, 32); + end loop; + Put ('"'); + end Disp_Const_Bit; + procedure Disp_X_Lit (W : Width) is Q : constant Character := Get_Lit_Quote (W); @@ -491,6 +512,32 @@ package body Netlists.Disp_Vhdl is end if; Put_Line (";"); end; + when Id_Dyn_Extract => + declare + O : constant Net := Get_Output (Inst, 0); + Wd : constant Width := Get_Width (O); + Step : constant Uns32 := Get_Param_Uns32 (Inst, 0); + Off : constant Uns32 := Get_Param_Uns32 (Inst, 1); + begin + Disp_Template (" \o0 <= \i0 (to_integer (\ui1)", Inst); + if Step /= 1 then + Disp_Template (" * \n0", Inst, (0 => Step)); + end if; + if Off /= 0 then + Disp_Template (" + \n0", Inst, (0 => Off)); + end if; + if Wd > 1 then + Disp_Template (" + \n0 - 1 downto to_integer (\ui1)", + Inst, (0 => Wd)); + if Step /= 1 then + Disp_Template (" * \n0", Inst, (0 => Step)); + end if; + if Off /= 0 then + Disp_Template (" + \n0", Inst, (0 => Off)); + end if; + end if; + Put_Line (");"); + end; when Id_Insert => declare Iw : constant Width := Get_Width (Get_Input_Net (Inst, 1)); @@ -536,6 +583,8 @@ package body Netlists.Disp_Vhdl is Disp_Template (" \o0 <= ", Inst); Disp_Constant_Inline (Inst); Put_Line (";"); + when Id_Const_Bit => + null; when Id_Adff => Disp_Template (" process (\i0, \i2)" & NL & " begin" & NL & @@ -615,7 +664,7 @@ package body Netlists.Disp_Vhdl is declare W : constant Width := Get_Width (Get_Output (Inst, 0)); begin - Disp_Template (" \o0 <= \i0 (\n0 downto 0);", + Disp_Template (" \o0 <= \i0 (\n0 downto 0); -- trunc" & NL, Inst, (0 => W - 1)); end; when Id_Uextend => @@ -671,6 +720,9 @@ package body Netlists.Disp_Vhdl is Put (" := "); Disp_Constant_Inline (Get_Parent (Get_Input_Net (Inst, 2))); + when Id_Const_Bit => + Put (" := "); + Disp_Const_Bit (Inst); when others => null; end case; diff --git a/src/synth/netlists-dump.adb b/src/synth/netlists-dump.adb index e6bb8517e..5d33cc664 100644 --- a/src/synth/netlists-dump.adb +++ b/src/synth/netlists-dump.adb @@ -193,9 +193,9 @@ package body Netlists.Dump is begin -- Module id and name. Put_Indent (Indent); - Put ("module ("); + Put ("module @"); Put_Trim (Module'Image (M)); - Put (") "); + Put (" "); Dump_Name (Get_Name (M)); New_Line; @@ -392,7 +392,12 @@ package body Netlists.Dump is Dump_Name (Get_Name (M)); - if Get_Nbr_Params (M) > 0 then + if True then + Put ('@'); + Put_Trim (Instance'Image (Inst)); + end if; + + if Get_Nbr_Params (Inst) > 0 then declare First : Boolean; begin @@ -415,12 +420,6 @@ package body Netlists.Dump is Dump_Name (Get_Name (Inst)); end if; - if True then - Put ('['); - Put_Trim (Instance'Image (Inst)); - Put (']'); - end if; - if Get_Nbr_Inputs (Inst) > 0 then declare First : Boolean; diff --git a/src/synth/netlists-gates.ads b/src/synth/netlists-gates.ads index 9a077f2f7..649503796 100644 --- a/src/synth/netlists-gates.ads +++ b/src/synth/netlists-gates.ads @@ -147,16 +147,20 @@ package Netlists.Gates is -- parameter, possibly signed or unsigned extended. For large width -- (> 128), the value is stored in a table. Id_Const_UB32 : constant Module_Id := 64; + Id_Const_UL32 : constant Module_Id := 70; Id_Const_SB32 : constant Module_Id := 65; Id_Const_UB64 : constant Module_Id := 66; Id_Const_SB64 : constant Module_Id := 67; Id_Const_UB128 : constant Module_Id := 68; Id_Const_SB128 : constant Module_Id := 69; - Id_Const_UL32 : constant Module_Id := 70; Id_Const_SL32 : constant Module_Id := 71; Id_Const_Z : constant Module_Id := 72; Id_Const_0 : constant Module_Id := 73; + -- Large width. + Id_Const_Bit : constant Module_Id := 74; + Id_Const_Log : constant Module_Id := 75; + -- Concatenation with N inputs. Id_Concatn : constant Module_Id := 80; end Netlists.Gates; diff --git a/src/synth/netlists-utils.adb b/src/synth/netlists-utils.adb index 43546e02a..43da83719 100644 --- a/src/synth/netlists-utils.adb +++ b/src/synth/netlists-utils.adb @@ -52,7 +52,12 @@ package body Netlists.Utils is is M : constant Module := Get_Module (Inst); begin - return Get_Nbr_Params (M); + case Get_Id (M) is + when Id_Const_Bit => + return Param_Nbr ((Get_Width (Get_Output (Inst, 0)) + 31) / 32); + when others => + return Get_Nbr_Params (M); + end case; end Get_Nbr_Params; function Get_Param_Desc diff --git a/src/synth/netlists.adb b/src/synth/netlists.adb index 72ceac948..1bde22ac6 100644 --- a/src/synth/netlists.adb +++ b/src/synth/netlists.adb @@ -19,6 +19,7 @@ -- MA 02110-1301, USA. with Netlists.Utils; use Netlists.Utils; +with Netlists.Gates; with Tables; package body Netlists is @@ -664,11 +665,19 @@ package body Netlists is function Get_Param_Desc (M : Module; Param : Param_Idx) return Param_Desc is + use Netlists.Gates; pragma Assert (Is_Valid (M)); - pragma Assert (Param < Get_Nbr_Params (M)); begin - return Param_Desc_Table.Table - (Modules_Table.Table (M).First_Param_Desc + Param_Desc_Idx (Param)); + case Get_Id (M) is + when Id_Const_Bit + | Id_Const_Log => + return (No_Sname, Param_Uns32); + when others => + pragma Assert (Param < Get_Nbr_Params (M)); + return Param_Desc_Table.Table + (Modules_Table.Table (M).First_Param_Desc + + Param_Desc_Idx (Param)); + end case; end Get_Param_Desc; function Get_Param_Idx (Inst : Instance; Param : Param_Idx) return Param_Idx @@ -683,7 +692,7 @@ package body Netlists is is pragma Assert (Is_Valid (Inst)); M : constant Module := Get_Module (Inst); - pragma Assert (Param < Get_Nbr_Params (M)); + pragma Assert (Param < Get_Nbr_Params (Inst)); pragma Assert (Get_Param_Desc (M, Param).Typ = Param_Uns32); begin return Params_Table.Table (Get_Param_Idx (Inst, Param)); @@ -693,7 +702,7 @@ package body Netlists is is pragma Assert (Is_Valid (Inst)); M : constant Module := Get_Module (Inst); - pragma Assert (Param < Get_Nbr_Params (M)); + pragma Assert (Param < Get_Nbr_Params (Inst)); pragma Assert (Get_Param_Desc (M, Param).Typ = Param_Uns32); begin Params_Table.Table (Get_Param_Idx (Inst, Param)) := Val; diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index f89a708b1..7681d8f3b 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -234,6 +234,123 @@ package body Synth.Context is return Val.Typ; end Get_Value_Type; + function Vec2net (Val : Value_Acc) return Net is + begin + if Val.Typ.Vbound.Len <= 32 then + declare + Len : constant Iir_Index32 := Iir_Index32 (Val.Typ.Vbound.Len); + R_Val, R_Zx : Uns32; + V, Zx : Uns32; + begin + R_Val := 0; + R_Zx := 0; + for I in 1 .. Len loop + To_Logic (Val.Arr.V (I).Scal, Val.Typ.Vec_El, V, Zx); + R_Val := R_Val or Shift_Left (V, Natural (Len - I)); + R_Zx := R_Zx or Shift_Left (Zx, Natural (Len - I)); + end loop; + if R_Zx = 0 then + return Build_Const_UB32 (Build_Context, R_Val, Uns32 (Len)); + else + return Build_Const_UL32 + (Build_Context, R_Val, R_Zx, Uns32 (Len)); + end if; + end; + else + -- Need Uconst64 / UconstBig + raise Internal_Error; + end if; + end Vec2net; + + pragma Unreferenced (Vec2net); + + type Logic_32 is record + Val : Uns32; -- AKA aval + Zx : Uns32; -- AKA bval + 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; + + procedure Value2net (Val : Value_Acc; + Vec : in out Logvec_Array; + Off : in out Uns32; + Has_Zx : in out Boolean) is + begin + case Val.Typ.Kind is + when Type_Bit => + declare + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + Va : Uns32; + Zx : Uns32; + begin + if Val.Typ = Logic_Type then + From_Std_Logic (Val.Scal, Va, Zx); + Has_Zx := Has_Zx or Zx /= 0; + else + Va := Uns32 (Val.Scal); + Zx := 0; + end if; + Va := Shift_Left (Va, Pos); + Zx := Shift_Left (Zx, Pos); + Vec (Idx).Val := Vec (Idx).Val or Va; + Vec (Idx).Zx := Vec (Idx).Zx or Zx; + Off := Off + 1; + end; + when Type_Vector => + -- TODO: optimize off mod 32 = 0. + for I in reverse Val.Arr.V'Range loop + Value2net (Val.Arr.V (I), Vec, Off, Has_Zx); + end loop; + when Type_Array => + for I in reverse Val.Arr.V'Range loop + Value2net (Val.Arr.V (I), Vec, Off, Has_Zx); + end loop; + when others => + raise Internal_Error; + end case; + end Value2net; + + procedure Value2net + (Val : Value_Acc; W : Width; Vec : in out Logvec_Array; Res : out Net) + is + Off : Uns32; + Has_Zx : Boolean; + Inst : Instance; + begin + Has_Zx := False; + Off := 0; + Value2net (Val, Vec, Off, Has_Zx); + if W <= 32 then + -- 32 bit result. + if not Has_Zx then + Res := Build_Const_UB32 (Build_Context, Vec (0).Val, W); + else + Res := Build_Const_UL32 + (Build_Context, Vec (0).Val, Vec (0).Zx, W); + end if; + return; + else + if not Has_Zx then + Inst := Build_Const_Bit (Build_Context, W); + for I in Vec'Range loop + Set_Param_Uns32 (Inst, Param_Idx (I), Vec (I).Val); + end loop; + Res := Get_Output (Inst, 0); + else + Inst := Build_Const_Log (Build_Context, W); + for I in Vec'Range loop + Set_Param_Uns32 (Inst, Param_Idx (2 * I), Vec (I).Val); + Set_Param_Uns32 (Inst, Param_Idx (2 * I + 1), Vec (I).Zx); + end loop; + Res := Get_Output (Inst, 0); + end if; + end if; + end Value2net; + function Get_Net (Val : Value_Acc) return Net is begin case Val.Kind is @@ -250,52 +367,37 @@ package body Synth.Context is I1 => Get_Net (Val.M_T)); end; when Value_Discrete => - declare - Va : Uns32; - Zx : Uns32; - begin - if Val.Typ = Logic_Type then - From_Std_Logic (Val.Scal, Va, Zx); - if Zx = 0 then - return Build_Const_UB32 (Build_Context, Va, 1); - else - return Build_Const_UL32 (Build_Context, Va, Zx, 1); - end if; - elsif Val.Typ = Boolean_Type then - From_Bit (Val.Scal, Va); - return Build_Const_UB32 (Build_Context, Va, 1); - else - return Build_Const_UB32 - (Build_Context, Uns32 (Val.Scal), Val.Typ.Drange.W); - end if; - end; - when Value_Array => - if Val.Typ.Vbound.Len <= 32 then + if Val.Typ.Kind = Type_Bit then declare - Len : constant Iir_Index32 := - Iir_Index32 (Val.Typ.Vbound.Len); - R_Val, R_Zx : Uns32; - V, Zx : Uns32; + V : Logvec_Array (0 .. 0) := (0 => (0, 0)); + Res : Net; begin - R_Val := 0; - R_Zx := 0; - for I in 1 .. Len loop - To_Logic (Val.Arr.V (I).Scal, Val.Typ.Vec_El, V, Zx); - R_Val := R_Val or Shift_Left (V, Natural (Len - I)); - R_Zx := R_Zx or Shift_Left (Zx, Natural (Len - I)); - end loop; - if R_Zx = 0 then - return Build_Const_UB32 - (Build_Context, R_Val, Uns32 (Len)); - else - return Build_Const_UL32 - (Build_Context, R_Val, R_Zx, Uns32 (Len)); - end if; + Value2net (Val, 1, V, Res); + return Res; end; + elsif Val.Typ.Drange.W <= 32 then + return Build_Const_UB32 + (Build_Context, Uns32 (Val.Scal), Val.Typ.Drange.W); else - -- Need Uconst64 / UconstBig raise Internal_Error; end if; + when Value_Array => + declare + W : constant Width := Get_Type_Width (Val.Typ); + Nd : constant Digit_Index := Digit_Index ((W + 31) / 32); + Res : Net; + begin + if Nd > 64 then + raise Internal_Error; + else + declare + Vec : Logvec_Array (0 .. Nd - 1) := (others => (0, 0)); + begin + Value2net (Val, W, Vec, Res); + return Res; + end; + end if; + end; when others => raise Internal_Error; end case; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index ee9f49fa4..8a22c2fa0 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -209,7 +209,6 @@ package body Synth.Decls is -- The elaboration of an index constraint consists of the -- declaration of each of the discrete ranges in the index -- constraint in some order that is not defined by the language. - Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); Etyp := Get_Value_Type (Syn_Inst, El_Type); if Is_One_Dimensional_Array_Type (Atype) then diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 37e9a8a44..abdedf37b 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -157,26 +157,6 @@ package body Synth.Expr is end case; end Bit_Extract; - function Dyn_Bit_Extract (Val : Value_Acc; Off : Net; Loc : Node) - return Value_Acc - is - N : Net; - begin - case Val.Kind is --- when Value_Array => --- pragma Assert (Val.Bounds.D (1).Len >= Off); --- return Val.Arr.V (Iir_Index32 (Val.Bounds.D (1).Len - Off)); - when Value_Net - | Value_Wire => - N := Build_Dyn_Extract - (Build_Context, Get_Net (Val), Off, 1, 0, 1); - Set_Location (N, Loc); - return Create_Value_Net (N, Val.Typ.Vec_El); - when others => - raise Internal_Error; - end case; - end Dyn_Bit_Extract; - function Synth_Uresize (N : Net; W : Width) return Net is Wn : constant Width := Get_Width (N); @@ -203,6 +183,36 @@ package body Synth.Expr is return Synth_Uresize (Get_Net (Val), W); end Synth_Uresize; + -- Resize for a discrete value. + function Synth_Resize (Val : Value_Acc; W : Width; Loc : Node) return Net + is + Wn : constant Width := Val.Typ.Drange.W; + N : Net; + Res : Net; + begin + if Is_Const (Val) then + raise Internal_Error; + end if; + + N := Get_Net (Val); + if Wn > W then + Res := Build_Trunc (Build_Context, Id_Utrunc, N, W); + Set_Location (Res, Loc); + return Res; + elsif Wn < W then + if Val.Typ.Drange.Is_Signed then + Res := Build_Extend (Build_Context, Id_Sextend, N, W); + else + Res := Build_Extend (Build_Context, Id_Uextend, N, W); + end if; + Set_Location (Res, Loc); + return Res; + else + return N; + end if; + end Synth_Resize; + + function Get_Index_Offset (Index : Value_Acc; Bounds : Bound_Type; Expr : Iir) return Uns32 is begin @@ -553,7 +563,9 @@ package body Synth.Expr is if Len < 0 then Len := 0; end if; - return (Dir => Rng.Dir, W => Width (Clog2 (Uns64 (Len))), + return (Dir => Rng.Dir, + Wlen => Width (Clog2 (Uns64 (Len))), + Wbounds => Rng.W, Left => Int32 (Rng.Left), Right => Int32 (Rng.Right), Len => Uns32 (Len)); end Synth_Bounds_From_Range; @@ -659,7 +671,8 @@ package body Synth.Expr is Res := (Left => Int32 (Index_Bounds.Left), Right => 0, Dir => Index_Bounds.Dir, - W => Width (Len), + Wbounds => Index_Bounds.W, + Wlen => Width (Clog2 (Uns64 (Len))), Len => Uns32 (Len)); if Len = 0 then @@ -1136,24 +1149,27 @@ package body Synth.Expr is end case; end Index_To_Offset; - function Dyn_Index_To_Offset (Pfx : Value_Acc; Idx : Net; Loc : Node) - return Net + function Dyn_Index_To_Offset + (Bnd : Bound_Type; Idx_Val : Value_Acc; Loc : Node) return Net is - Bnd : constant Type_Acc := Pfx.Typ; + Idx2 : Net; Off : Net; Right : Net; begin -- TODO: handle width. - Right := Build_Const_UB32 - (Build_Context, To_Uns32 (Bnd.Vbound.Right), 32); + Right := Build_Const_UB32 (Build_Context, To_Uns32 (Bnd.Right), + Bnd.Wbounds); Set_Location (Right, Loc); - case Bnd.Vbound.Dir is + + Idx2 := Synth_Resize (Idx_Val, Bnd.Wbounds, Loc); + + case Bnd.Dir is when Iir_To => -- L <= I <= R --> off = R - I - Off := Build_Dyadic (Build_Context, Id_Sub, Right, Idx); + Off := Build_Dyadic (Build_Context, Id_Sub, Right, Idx2); when Iir_Downto => -- L >= I >= R --> off = I - R - Off := Build_Dyadic (Build_Context, Id_Sub, Idx, Right); + Off := Build_Dyadic (Build_Context, Id_Sub, Idx2, Right); end case; Set_Location (Off, Loc); return Off; @@ -1162,36 +1178,58 @@ package body Synth.Expr is function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Value_Acc is - Pfx : constant Node := Get_Prefix (Name); - Pfx_Val : constant Value_Acc := Synth_Expression (Syn_Inst, Pfx); Indexes : constant Iir_Flist := Get_Index_List (Name); Idx_Expr : constant Node := Get_Nth_Element (Indexes, 0); Idx_Val : Value_Acc; + Pfx_Val : Value_Acc; begin if Get_Nbr_Elements (Indexes) /= 1 then - Error_Msg_Synth (+Name, "multi-dim arrays not supported"); + Error_Msg_Synth (+Name, "multi-dim arrays not yet supported"); return null; end if; + Pfx_Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); + + -- Use the base type as the subtype of the index is not synth-ed. Idx_Val := Synth_Expression_With_Type (Syn_Inst, Idx_Expr, Get_Base_Type (Get_Type (Idx_Expr))); - if Idx_Val.Kind = Value_Discrete then - declare - Off : Uns32; - begin - Off := Index_To_Offset (Pfx_Val, Idx_Val.Scal, Name); - return Bit_Extract (Pfx_Val, Off, Name); - end; - else + if Pfx_Val.Typ.Kind = Type_Vector then + if Idx_Val.Kind = Value_Discrete then + declare + Off : Uns32; + begin + Off := Index_To_Offset (Pfx_Val, Idx_Val.Scal, Name); + return Bit_Extract (Pfx_Val, Off, Name); + end; + else + declare + Off : Net; + Res : Net; + begin + Off := Dyn_Index_To_Offset (Pfx_Val.Typ.Vbound, Idx_Val, Name); + Res := Build_Dyn_Extract + (Build_Context, Get_Net (Pfx_Val), Off, 1, 0, 1); + Set_Location (Res, Name); + return Create_Value_Net (Res, Pfx_Val.Typ.Vec_El); + end; + end if; + elsif Pfx_Val.Typ.Kind = Type_Array then declare - Idx : Net; Off : Net; + Res : Net; + El_Width : Width; begin - Idx := Get_Net (Idx_Val); - Off := Dyn_Index_To_Offset (Pfx_Val, Idx, Name); - return Dyn_Bit_Extract (Pfx_Val, Off, Name); + Off := Dyn_Index_To_Offset + (Pfx_Val.Typ.Abounds.D (1), Idx_Val, Name); + El_Width := Get_Type_Width (Pfx_Val.Typ.Arr_El); + Res := Build_Dyn_Extract + (Build_Context, Get_Net (Pfx_Val), Off, El_Width, 0, El_Width); + Set_Location (Res, Name); + return Create_Value_Net (Res, Pfx_Val.Typ.Arr_El); end; + else + raise Internal_Error; end if; end Synth_Indexed_Name; @@ -1302,7 +1340,7 @@ package body Synth.Expr is -- Identify LEFT to/downto RIGHT as: -- INP * STEP + WIDTH - 1 + OFF to/downto INP * STEP + OFF procedure Synth_Extract_Dyn_Suffix (Loc : Node; - Pfx_Bnd : Type_Acc; + Pfx_Bnd : Bound_Type; Left : Net; Right : Net; Inp : out Net; @@ -1346,20 +1384,20 @@ package body Synth.Expr is -- FIXME: what to do with negative values. Step := Uns32 (L_Fac); - case Pfx_Bnd.Vbound.Dir is + case Pfx_Bnd.Dir is when Iir_To => - Off := L_Add - Pfx_Bnd.Vbound.Left; + Off := L_Add - Pfx_Bnd.Left; Width := Uns32 (R_Add - L_Add + 1); when Iir_Downto => - Off := R_Add - Pfx_Bnd.Vbound.Right; + Off := R_Add - Pfx_Bnd.Right; Width := Uns32 (L_Add - R_Add + 1); end case; end Synth_Extract_Dyn_Suffix; procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; Name : Node; - Pfx_Bnd : Type_Acc; - Res_Bnd : out Type_Acc; + Pfx_Bnd : Bound_Type; + Res_Bnd : out Bound_Type; Inp : out Net; Step : out Uns32; Off : out Int32; @@ -1369,7 +1407,6 @@ package body Synth.Expr is Left, Right : Value_Acc; Dir : Iir_Direction; begin - Res_Bnd := null; Off := 0; case Get_Kind (Expr) is @@ -1381,7 +1418,7 @@ package body Synth.Expr is Error_Msg_Synth (+Expr, "only range supported for slices"); end case; - if Pfx_Bnd.Vbound.Dir /= Dir then + if Pfx_Bnd.Dir /= Dir then Error_Msg_Synth (+Name, "direction mismatch in slice"); Step := 0; Wd := 0; @@ -1402,8 +1439,8 @@ package body Synth.Expr is Inp := No_Net; Step := 0; - if not In_Bounds (Pfx_Bnd.Vbound, Int32 (Left.Scal)) - or else not In_Bounds (Pfx_Bnd.Vbound, Int32 (Right.Scal)) + if not In_Bounds (Pfx_Bnd, Int32 (Left.Scal)) + or else not In_Bounds (Pfx_Bnd, Int32 (Right.Scal)) then Error_Msg_Synth (+Name, "index not within bounds"); Wd := 0; @@ -1411,27 +1448,25 @@ package body Synth.Expr is return; end if; - case Pfx_Bnd.Vbound.Dir is + case Pfx_Bnd.Dir is when Iir_To => Wd := Width (Right.Scal - Left.Scal + 1); - Res_Bnd := Create_Vector_Type - (Bound_Type'(Dir => Iir_To, - W => Wd, - Len => Wd, - Left => Int32 (Left.Scal), - Right => Int32 (Right.Scal)), - Pfx_Bnd.Vec_El); - Off := Pfx_Bnd.Vbound.Right - Res_Bnd.Vbound.Right; + Res_Bnd := (Dir => Iir_To, + Wlen => Wd, + Wbounds => Wd, + Len => Wd, + Left => Int32 (Left.Scal), + Right => Int32 (Right.Scal)); + Off := Pfx_Bnd.Right - Res_Bnd.Right; when Iir_Downto => Wd := Width (Left.Scal - Right.Scal + 1); - Res_Bnd := Create_Vector_Type - (Bound_Type'(Dir => Iir_Downto, - W => Wd, - Len => Wd, - Left => Int32 (Left.Scal), - Right => Int32 (Right.Scal)), - Pfx_Bnd.Vec_El); - Off := Res_Bnd.Vbound.Right - Pfx_Bnd.Vbound.Right; + Res_Bnd := (Dir => Iir_Downto, + Wlen => Wd, + Wbounds => Wd, + Len => Wd, + Left => Int32 (Left.Scal), + Right => Int32 (Right.Scal)); + Off := Res_Bnd.Right - Pfx_Bnd.Right; end case; end if; end Synth_Slice_Suffix; @@ -1441,24 +1476,27 @@ package body Synth.Expr is is Pfx_Node : constant Node := Get_Prefix (Name); Pfx : constant Value_Acc := Synth_Expression (Syn_Inst, Pfx_Node); - Bnd : constant Type_Acc := Pfx.Typ; - Res_Bnd : Type_Acc; + Res_Bnd : Bound_Type; + Res_Type : Type_Acc; Inp : Net; Step : Uns32; Off : Int32; Wd : Uns32; N : Net; begin - Synth_Slice_Suffix (Syn_Inst, Name, Bnd, Res_Bnd, Inp, Step, Off, Wd); + Synth_Slice_Suffix + (Syn_Inst, Name, Pfx.Typ.Vbound, Res_Bnd, Inp, Step, Off, Wd); if Inp /= No_Net then N := Build_Dyn_Extract (Build_Context, Get_Net (Pfx), Inp, Step, Off, Wd); Set_Location (N, Name); + -- TODO: the bounds cannot be created as they are not known. return Create_Value_Net (N, null); else N := Build_Extract (Build_Context, Get_Net (Pfx), Uns32 (Off), Wd); Set_Location (N, Name); - return Create_Value_Net (N, Res_Bnd); + Res_Type := Create_Vector_Type (Res_Bnd, Pfx.Typ.Vec_El); + return Create_Value_Net (N, Res_Type); end if; end Synth_Slice_Name; @@ -1771,9 +1809,16 @@ package body Synth.Expr is end; when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat => -- UNSIGNED to Natural. - return Create_Value_Net - (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)), 32), - null); + declare + Nat_Type : constant Type_Acc := + Get_Value_Type (Syn_Inst, + Vhdl.Std_Package.Natural_Subtype_Definition); + begin + return Create_Value_Net + (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)), + Nat_Type.Drange.W), + Nat_Type); + end; when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat => declare V : constant Value_Acc := Subprg_Inst.Objects (1); diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index f2ec51476..039dab5d6 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -74,8 +74,8 @@ package Synth.Expr is procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; Name : Node; - Pfx_Bnd : Type_Acc; - Res_Bnd : out Type_Acc; + Pfx_Bnd : Bound_Type; + Res_Bnd : out Bound_Type; Inp : out Net; Step : out Uns32; Off : out Int32; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 3d779f54c..468733b09 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -161,7 +161,8 @@ package body Synth.Stmts is Pfx : constant Node := Get_Prefix (Target); Targ : constant Value_Acc := Get_Value (Syn_Inst, Get_Base_Name (Pfx)); - Res_Bnd : Type_Acc; + Res_Bnd : Bound_Type; + Res_Type : Type_Acc; Targ_Net : Net; Inp : Net; Step : Uns32; @@ -174,7 +175,7 @@ package body Synth.Stmts is -- Only support assignment of vector. raise Internal_Error; end if; - Synth_Slice_Suffix (Syn_Inst, Target, Targ.Typ, + Synth_Slice_Suffix (Syn_Inst, Target, Targ.Typ.Vbound, Res_Bnd, Inp, Step, Off, Wd); Targ_Net := Get_Last_Assigned_Value (Targ.W); V := Get_Net (Val); @@ -186,7 +187,8 @@ package body Synth.Stmts is (Build_Context, Targ_Net, V, Uns32 (Off)); end if; Set_Location (Res, Target); - Synth_Assign (Targ, Create_Value_Net (Res, Res_Bnd)); + Res_Type := Create_Vector_Type (Res_Bnd, Targ.Typ.Vec_El); + Synth_Assign (Targ, Create_Value_Net (Res, Res_Type)); end; when others => Error_Kind ("synth_assignment", Target); diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 699705977..c6b0b1ae5 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -20,6 +20,7 @@ with Ada.Unchecked_Conversion; with System; +with Mutils; package body Synth.Values is function To_Bound_Array_Acc is new Ada.Unchecked_Conversion @@ -86,10 +87,13 @@ package body Synth.Values is end Create_Vector_Type; function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) - return Type_Acc is + return Type_Acc + is + W : constant Width := Uns32 (Mutils.Clog2 (Uns64 (Len))); begin return Create_Vector_Type ((Dir => Iir_Downto, - W => 0, + Wlen => W, + Wbounds => W, Left => Int32 (Len) - 1, Right => 0, Len => Len), @@ -337,6 +341,16 @@ package body Synth.Values is return Atype.Drange.W; when Type_Vector => return Atype.Vbound.Len; + when Type_Array => + declare + Res : Width; + begin + Res := Get_Type_Width (Atype.Arr_El); + for I in Atype.Abounds.D'Range loop + Res := Res * Atype.Abounds.D (I).Len; + end loop; + return Res; + end; when others => raise Internal_Error; end case; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index f754c73be..f62c2cbbf 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -30,7 +30,7 @@ package Synth.Values is -- An integer range. Dir : Iir_Direction; - -- Netlist representation: signed or unsigned, width of bus. + -- Netlist representation: signed or unsigned, width of vector. Is_Signed : Boolean; W : Width; @@ -46,10 +46,18 @@ package Synth.Values is type Bound_Type is record Dir : Iir_Direction; - W : Width; Left : Int32; Right : Int32; Len : Width; + + -- Width of length. This is the number of address bits. + Wlen : Width; + + -- Width of bounds. This is the precision used to compute the + -- address. + -- If bounds are 1 to 128 (so left = 1, dir = to, right = 128), + -- Wlen = 7 and Wbounds = 8. + Wbounds : Width; end record; type Bound_Array_Type is array (Iir_Index32 range <>) of Bound_Type; diff --git a/src/vhdl/vhdl-nodes.ads b/src/vhdl/vhdl-nodes.ads index f44f6c4e0..a884f7b9d 100644 --- a/src/vhdl/vhdl-nodes.ads +++ b/src/vhdl/vhdl-nodes.ads @@ -4880,6 +4880,8 @@ package Vhdl.Nodes is -- Numeric_Std. -- Abbreviations: -- Uns: Unsigned, Sgn: Signed, Nat: Natural, Int: Integer. + + -- To_Integer, To_Unsigned, to_Signed Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat, Iir_Predefined_Ieee_Numeric_Std_Toint_Sgn_Int, Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns, -- cgit v1.2.3