From a7d9aa91b5a9f4847edf71c80b70cfec6d646fd9 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Tue, 1 Oct 2019 06:09:55 +0200 Subject: synth: improve support of arrays or arrays. Fix #955 --- src/synth/netlists-builders.adb | 8 ++-- src/synth/netlists-builders.ads | 4 +- src/synth/synth-decls.adb | 7 ++- src/synth/synth-expr.adb | 100 +++++++++++++++++++++++++++++----------- src/synth/synth-expr.ads | 5 +- src/synth/synth-oper.adb | 8 ++-- src/synth/synth-stmts.adb | 11 ++--- src/synth/synth-values.adb | 4 +- src/synth/synth-values.ads | 4 +- src/vhdl/vhdl-utils.adb | 21 ++++----- 10 files changed, 110 insertions(+), 62 deletions(-) (limited to 'src') diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb index b6fdcbb92..e0c749792 100644 --- a/src/synth/netlists-builders.adb +++ b/src/synth/netlists-builders.adb @@ -922,7 +922,7 @@ package body Netlists.Builders is function Build_Dyn_Insert (Ctxt : Context_Acc; - I : Net; V : Net; P : Net; Step : Uns32; Off : Int32) + I : Net; V : Net; P : Net; Step : Uns32; Off : Uns32) return Net is Wd : constant Width := Get_Width (I); @@ -939,7 +939,7 @@ package body Netlists.Builders is end if; Connect (Get_Input (Inst, 2), P); Set_Param_Uns32 (Inst, 0, Step); - Set_Param_Uns32 (Inst, 1, To_Uns32 (Off)); + Set_Param_Uns32 (Inst, 1, Off); return O; end Build_Dyn_Insert; @@ -1114,7 +1114,7 @@ package body Netlists.Builders is function Build_Dyn_Extract (Ctxt : Context_Acc; - I : Net; P : Net; Step : Uns32; Off : Int32; W : Width) return Net + I : Net; P : Net; Step : Uns32; Off : Uns32; W : Width) return Net is Wd : constant Width := Get_Width (I); pragma Assert (Wd /= No_Width); @@ -1128,7 +1128,7 @@ package body Netlists.Builders is Connect (Get_Input (Inst, 0), I); Connect (Get_Input (Inst, 1), P); Set_Param_Uns32 (Inst, 0, Step); - Set_Param_Uns32 (Inst, 1, To_Uns32 (Off)); + Set_Param_Uns32 (Inst, 1, Off); return O; end Build_Dyn_Extract; diff --git a/src/synth/netlists-builders.ads b/src/synth/netlists-builders.ads index 6d76d4663..5a658c14f 100644 --- a/src/synth/netlists-builders.ads +++ b/src/synth/netlists-builders.ads @@ -130,10 +130,10 @@ package Netlists.Builders is (Ctxt : Context_Acc; I : Net; Off : Width) return Net; function Build_Dyn_Extract (Ctxt : Context_Acc; - I : Net; P : Net; Step : Uns32; Off : Int32; W : Width) return Net; + I : Net; P : Net; Step : Uns32; Off : Uns32; W : Width) return Net; function Build_Dyn_Insert - (Ctxt : Context_Acc; I : Net; V : Net; P : Net; Step : Uns32; Off : Int32) + (Ctxt : Context_Acc; I : Net; V : Net; P : Net; Step : Uns32; Off : Uns32) return Net; function Build_Output (Ctxt : Context_Acc; W : Width) return Net; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 83626b6c4..19a5f75ba 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -76,18 +76,17 @@ package body Synth.Decls is (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc is El_Type : constant Node := Get_Element_Subtype (Def); + Ndims : constant Natural := Get_Nbr_Dimensions (Def); El_Typ : Type_Acc; Typ : Type_Acc; begin Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); El_Typ := Get_Value_Type (Syn_Inst, El_Type); - if El_Typ.Kind in Type_Nets - and then Is_One_Dimensional_Array_Type (Def) - then + if El_Typ.Kind in Type_Nets and then Ndims = 1 then Typ := Create_Unbounded_Vector (El_Typ); else - Typ := Create_Unbounded_Array (El_Typ); + Typ := Create_Unbounded_Array (Iir_Index32 (Ndims), El_Typ); end if; return Typ; end Synth_Array_Type_Definition; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 988cb89c3..9e5ccff6a 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -893,6 +893,50 @@ package body Synth.Expr is return Off; end Dyn_Index_To_Offset; + -- Return the bounds of a one dimensional array/vector type and the + -- width of the element. + procedure Get_Onedimensional_Array_Bounds + (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc) is + begin + case Typ.Kind is + when Type_Vector => + El_Typ := Typ.Vec_El; + Bnd := Typ.Vbound; + when Type_Array => + El_Typ := Typ.Arr_El; + Bnd := Typ.Abounds.D (1); + when others => + raise Internal_Error; + end case; + end Get_Onedimensional_Array_Bounds; + + function Create_Onedimensional_Array_Subtype + (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc + is + Res : Type_Acc; + Bnds : Bound_Array_Acc; + begin + case Btyp.Kind is + when Type_Vector => + Res := Create_Vector_Type (Bnd, Btyp.Vec_El); + when Type_Unbounded_Vector => + Res := Create_Vector_Type (Bnd, Btyp.Uvec_El); + when Type_Array => + pragma Assert (Btyp.Abounds.Len = 1); + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res := Create_Array_Type (Bnds, Btyp.Arr_El); + when Type_Unbounded_Array => + pragma Assert (Btyp.Uarr_Ndim = 1); + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res := Create_Array_Type (Bnds, Btyp.Uarr_El); + when others => + raise Internal_Error; + end case; + return Res; + end Create_Onedimensional_Array_Subtype; + procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node; Pfx_Type : Type_Acc; @@ -906,6 +950,7 @@ package body Synth.Expr is Idx_Val : Value_Acc; Idx_Type : Type_Acc; Bnd : Bound_Type; + El_Typ : Type_Acc; begin if Get_Nbr_Elements (Indexes) /= 1 then Error_Msg_Synth (+Name, "multi-dim arrays not yet supported"); @@ -917,21 +962,13 @@ package body Synth.Expr is (Syn_Inst, Get_Base_Type (Get_Type (Idx_Expr))); Idx_Val := Synth_Expression_With_Type (Syn_Inst, Idx_Expr, Idx_Type); - case Pfx_Type.Kind is - when Type_Vector => - W := 1; - Bnd := Pfx_Type.Vbound; - when Type_Array => - W := Get_Type_Width (Pfx_Type.Arr_El); - Bnd := Pfx_Type.Abounds.D (1); - when others => - raise Internal_Error; - end case; + Get_Onedimensional_Array_Bounds (Pfx_Type, Bnd, El_Typ); + W := El_Typ.W; if Idx_Val.Kind = Value_Discrete then Voff := No_Net; Mul := 0; - Off := Index_To_Offset (Bnd, Idx_Val.Scal, Name); + Off := Index_To_Offset (Bnd, Idx_Val.Scal, Name) * W; else Voff := Dyn_Index_To_Offset (Bnd, Idx_Val, Name); Off := 0; @@ -947,11 +984,13 @@ package body Synth.Expr is Mul : Uns32; Off : Uns32; W : Width; + El_Typ : Type_Acc; Res : Net; begin Pfx_Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); Synth_Indexed_Name (Syn_Inst, Name, Pfx_Val.Typ, Voff, Mul, Off, W); + El_Typ := Get_Array_Element (Pfx_Val.Typ); if Voff = No_Net then pragma Assert (Mul = 0); @@ -960,13 +999,14 @@ package body Synth.Expr is else Res := Build_Extract (Build_Context, Get_Net (Pfx_Val), Off, W); Set_Location (Res, Name); - return Create_Value_Net (Res, Get_Array_Element (Pfx_Val.Typ)); + return Create_Value_Net (Res, El_Typ); end if; else - Res := Build_Dyn_Extract - (Build_Context, Get_Net (Pfx_Val), Voff, Mul, Int32 (Off), W); + pragma Assert (Off = 0); + Res := Build_Dyn_Extract (Build_Context, Get_Net (Pfx_Val), + Voff, Mul, Off, W); Set_Location (Res, Name); - return Create_Value_Net (Res, Get_Array_Element (Pfx_Val.Typ)); + return Create_Value_Net (Res, El_Typ); end if; end Synth_Indexed_Name; @@ -1096,7 +1136,7 @@ package body Synth.Expr is Right : Net; Inp : out Net; Step : out Uns32; - Off : out Int32; + Off : out Uns32; Width : out Uns32) is L_Inp, R_Inp : Net; @@ -1137,10 +1177,10 @@ package body Synth.Expr is case Pfx_Bnd.Dir is when Iir_To => - Off := L_Add - Pfx_Bnd.Left; + Off := Uns32 (L_Add - Pfx_Bnd.Left); Width := Uns32 (R_Add - L_Add + 1); when Iir_Downto => - Off := R_Add - Pfx_Bnd.Right; + Off := Uns32 (R_Add - Pfx_Bnd.Right); Width := Uns32 (L_Add - R_Add + 1); end case; end Synth_Extract_Dyn_Suffix; @@ -1151,7 +1191,7 @@ package body Synth.Expr is Res_Bnd : out Bound_Type; Inp : out Net; Step : out Uns32; - Off : out Int32; + Off : out Uns32; Wd : out Uns32) is Expr : constant Node := Get_Suffix (Name); @@ -1204,7 +1244,7 @@ package body Synth.Expr is Len => Wd, Left => Int32 (L), Right => Int32 (R)); - Off := Pfx_Bnd.Right - Res_Bnd.Right; + Off := Uns32 (Pfx_Bnd.Right - Res_Bnd.Right); when Iir_Downto => Wd := Width (L - R + 1); Res_Bnd := (Dir => Iir_Downto, @@ -1213,7 +1253,7 @@ package body Synth.Expr is Len => Wd, Left => Int32 (L), Right => Int32 (R)); - Off := Res_Bnd.Right - Pfx_Bnd.Right; + Off := Uns32 (Res_Bnd.Right - Pfx_Bnd.Right); end case; end; else @@ -1235,27 +1275,33 @@ package body Synth.Expr is Pfx_Node : constant Node := Get_Prefix (Name); Pfx : constant Value_Acc := Synth_Expression_With_Basetype (Syn_Inst, Pfx_Node); + Pfx_Bnd : Bound_Type; + El_Typ : Type_Acc; Res_Bnd : Bound_Type; Res_Type : Type_Acc; Inp : Net; Step : Uns32; - Off : Int32; + Off : Uns32; Wd : Uns32; N : Net; begin + Get_Onedimensional_Array_Bounds (Pfx.Typ, Pfx_Bnd, El_Typ); + Synth_Slice_Suffix - (Syn_Inst, Name, Pfx.Typ.Vbound, Res_Bnd, Inp, Step, Off, Wd); + (Syn_Inst, Name, Pfx_Bnd, Res_Bnd, Inp, Step, Off, Wd); if Inp /= No_Net then N := Build_Dyn_Extract (Build_Context, Get_Net (Pfx), - Inp, Step, Off, Wd); + Inp, Step * El_Typ.W, Off * El_Typ.W, + Wd * El_Typ.W); Set_Location (N, Name); -- TODO: the bounds cannot be created as they are not known. - Res_Type := Create_Slice_Type (Wd, Pfx.Typ.Vec_El); + Res_Type := Create_Slice_Type (Wd, El_Typ); return Create_Value_Net (N, Res_Type); else - N := Build_Extract (Build_Context, Get_Net (Pfx), Uns32 (Off), Wd); + N := Build_Extract (Build_Context, Get_Net (Pfx), + Off * El_Typ.W, Wd * El_Typ.W); Set_Location (N, Name); - Res_Type := Create_Vector_Type (Res_Bnd, Pfx.Typ.Vec_El); + Res_Type := Create_Onedimensional_Array_Subtype (Pfx.Typ, Res_Bnd); return Create_Value_Net (N, Res_Type); end if; end Synth_Slice_Name; diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index dbe092434..92104fc75 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -41,6 +41,9 @@ package Synth.Expr is function Get_Const_Discrete (V : Value_Acc) return Int64; + function Create_Onedimensional_Array_Subtype + (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc; + procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32); procedure From_Bit (Enum : Int64; Val : out Uns32); procedure To_Logic @@ -98,7 +101,7 @@ package Synth.Expr is Res_Bnd : out Bound_Type; Inp : out Net; Step : out Uns32; - Off : out Int32; + Off : out Uns32; Wd : out Uns32); procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb index 096bbba44..865326e95 100644 --- a/src/synth/synth-oper.adb +++ b/src/synth/synth-oper.adb @@ -585,7 +585,7 @@ package body Synth.Oper is Iir_Index32 (Get_Width (L) + 1)); return Create_Value_Net - (N, Create_Vector_Type (Bnd, Right.Typ)); + (N, Create_Onedimensional_Array_Subtype (Left_Typ, Bnd)); end; when Iir_Predefined_Element_Array_Concat => declare @@ -601,10 +601,12 @@ package body Synth.Oper is Iir_Index32 (Get_Width (R) + 1)); return Create_Value_Net - (N, Create_Vector_Type (Bnd, Left.Typ)); + (N, Create_Onedimensional_Array_Subtype (Right_Typ, Bnd)); end; when Iir_Predefined_Element_Element_Concat => declare + Ret_Typ : constant Type_Acc := + Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); N : Net; Bnd : Bound_Type; begin @@ -614,7 +616,7 @@ package body Synth.Oper is Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2); return Create_Value_Net - (N, Create_Vector_Type (Bnd, Left.Typ)); + (N, Create_Onedimensional_Array_Subtype (Ret_Typ, Bnd)); end; when Iir_Predefined_Array_Array_Concat => declare diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index c0b810b54..f64a4b9e4 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -186,7 +186,7 @@ package body Synth.Stmts is Res_Bnd : Bound_Type; Inp : Net; Step : Uns32; - Sl_Off : Int32; + Sl_Off : Uns32; Wd : Uns32; begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), @@ -201,7 +201,7 @@ package body Synth.Stmts is end if; Dest_Type := Create_Vector_Type (Res_Bnd, Dest_Type.Vec_El); - Dest_Off := Dest_Off + Uns32 (Sl_Off); + Dest_Off := Dest_Off + Sl_Off; end; when others => @@ -305,8 +305,7 @@ package body Synth.Stmts is Targ_Net := Get_Current_Assign_Value (Build_Context, Obj.W, Off, Get_Type_Width (Typ)); V := Build_Dyn_Insert - (Build_Context, Targ_Net, No_Net, - Voff, Mul, Int32 (Idx_Off)); + (Build_Context, Targ_Net, No_Net, Voff, Mul, Idx_Off); Set_Location (V, Target); return Target_Info'(Kind => Target_Memory, Targ_Type => El_Typ, @@ -324,7 +323,7 @@ package body Synth.Stmts is Res_Bnd : Bound_Type; Inp : Net; Step : Uns32; - Sl_Off : Int32; + Sl_Off : Uns32; Wd : Uns32; Targ_Net : Net; @@ -352,7 +351,7 @@ package body Synth.Stmts is return Target_Info'(Kind => Target_Simple, Targ_Type => Res_Type, Obj => Obj, - Off => Off + Uns32 (Sl_Off)); + Off => Off + Sl_Off); end if; end; when others => diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index ed30ffd3d..22bbd4fba 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -283,13 +283,15 @@ package body Synth.Values is Arr_El => El_Type))); end Create_Array_Type; - function Create_Unbounded_Array (El_Type : Type_Acc) return Type_Acc + function Create_Unbounded_Array (Ndim : Iir_Index32; El_Type : Type_Acc) + return Type_Acc is subtype Unbounded_Type_Type is Type_Type (Type_Unbounded_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Unbounded_Type_Type); begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Unbounded_Array, W => 0, + Uarr_Ndim => Ndim, Uarr_El => El_Type))); end Create_Unbounded_Array; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index f897bdf8a..28661d41a 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -125,6 +125,7 @@ package Synth.Values is Abounds : Bound_Array_Acc; Arr_El : Type_Acc; when Type_Unbounded_Array => + Uarr_Ndim : Iir_Index32; Uarr_El : Type_Acc; when Type_Record => Rec : Rec_El_Array_Acc; @@ -231,7 +232,8 @@ package Synth.Values is function Create_Bound_Array (Ndims : Iir_Index32) return Bound_Array_Acc; function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) return Type_Acc; - function Create_Unbounded_Array (El_Type : Type_Acc) return Type_Acc; + function Create_Unbounded_Array (Ndim : Iir_Index32; El_Type : Type_Acc) + return Type_Acc; function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc; function Create_Record_Type (Els : Rec_El_Array_Acc; W : Width) diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index 4269bdbf2..a3f0f3223 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -1043,6 +1043,14 @@ package body Vhdl.Utils is return Get_Nbr_Elements (Get_Index_Subtype_List (Array_Type)); end Get_Nbr_Dimensions; + function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean + is + Base_Type : constant Iir := Get_Base_Type (A_Type); + begin + return Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition + and then Get_Nbr_Dimensions (Base_Type) = 1; + end Is_One_Dimensional_Array_Type; + function Are_Array_Indexes_Locally_Static (Array_Type : Iir) return Boolean is Indexes : constant Iir_Flist := Get_Index_Subtype_List (Array_Type); @@ -1407,19 +1415,6 @@ package body Vhdl.Utils is end case; end Get_High_Limit; - function Is_One_Dimensional_Array_Type (A_Type : Iir) return Boolean - is - Base_Type : constant Iir := Get_Base_Type (A_Type); - begin - if Get_Kind (Base_Type) = Iir_Kind_Array_Type_Definition - and then Get_Nbr_Elements (Get_Index_Subtype_List (Base_Type)) = 1 - then - return True; - else - return False; - end if; - end Is_One_Dimensional_Array_Type; - function Is_Range_Attribute_Name (Expr : Iir) return Boolean is Attr : Iir; -- cgit v1.2.3