From 9ee5974eb73b553de30a64e635c328f92b2296a3 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 21 May 2022 21:21:22 +0200 Subject: synth: use unidimentional arrays in type_acc. Factorize code. --- src/synth/elab-vhdl_debug.adb | 15 +- src/synth/elab-vhdl_expr.adb | 117 +++++---- src/synth/elab-vhdl_expr.ads | 14 ++ src/synth/elab-vhdl_files.adb | 16 +- src/synth/elab-vhdl_objtypes.adb | 65 +++-- src/synth/elab-vhdl_objtypes.ads | 10 +- src/synth/elab-vhdl_types.adb | 22 +- src/synth/elab-vhdl_values-debug.adb | 77 +++--- src/synth/elab-vhdl_values.adb | 26 +- src/synth/synth-disp_vhdl.adb | 4 +- src/synth/synth-vhdl_aggr.adb | 35 ++- src/synth/synth-vhdl_eval.adb | 9 +- src/synth/synth-vhdl_expr.adb | 448 ++++++++--------------------------- src/synth/synth-vhdl_expr.ads | 1 + src/synth/synth-vhdl_insts.adb | 19 +- src/synth/synth-vhdl_oper.adb | 8 +- src/synth/synth-vhdl_stmts.adb | 6 +- 17 files changed, 340 insertions(+), 552 deletions(-) (limited to 'src/synth') diff --git a/src/synth/elab-vhdl_debug.adb b/src/synth/elab-vhdl_debug.adb index f7820edf5..6b137b892 100644 --- a/src/synth/elab-vhdl_debug.adb +++ b/src/synth/elab-vhdl_debug.adb @@ -116,25 +116,22 @@ package body Elab.Vhdl_Debug is end if; end Disp_Value_Vector; - procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node; Dim: Dim_Type) + procedure Disp_Value_Array (Mem : Memtyp; A_Type: Node) is Stride : Size_Type; begin - if Dim = Mem.Typ.Abounds.Ndim then + if Mem.Typ.Alast then -- Last dimension - Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abounds.D (Dim)); + Disp_Value_Vector (Mem, A_Type, Mem.Typ.Abound); else Stride := Mem.Typ.Arr_El.Sz; - for I in Dim + 1 .. Mem.Typ.Abounds.Ndim loop - Stride := Stride * Size_Type (Mem.Typ.Abounds.D (I).Len); - end loop; Put ("("); - for I in 1 .. Mem.Typ.Abounds.D (Dim).Len loop + for I in 1 .. Mem.Typ.Abound.Len loop if I /= 1 then Put (", "); end if; - Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type, Dim + 1); + Disp_Value_Array ((Mem.Typ, Mem.Mem + Stride), A_Type); end loop; Put (")"); end if; @@ -155,7 +152,7 @@ package body Elab.Vhdl_Debug is when Type_Vector => Disp_Value_Vector (M, Vtype, M.Typ.Vbound); when Type_Array => - Disp_Value_Array (M, Vtype, 1); + Disp_Value_Array (M, Vtype); when Type_Float => Put ("*float*"); when Type_Slice => diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb index a920d2a8f..6982b825f 100644 --- a/src/synth/elab-vhdl_expr.adb +++ b/src/synth/elab-vhdl_expr.adb @@ -60,15 +60,7 @@ package body Elab.Vhdl_Expr is declare Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); begin - case Bnds.Kind is - when Type_Vector => - pragma Assert (Dim = 1); - return Bnds.Vbound; - when Type_Array => - return Bnds.Abounds.D (Dim); - when others => - raise Internal_Error; - end case; + return Get_Array_Bound (Bnds, Dim); end; end if; end Synth_Array_Bounds; @@ -94,8 +86,8 @@ package body Elab.Vhdl_Expr is end case; end Synth_Bounds_From_Length; - function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node) return Valtyp + function Exec_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node) return Valtyp is Aggr_Type : constant Node := Get_Type (Aggr); pragma Assert (Get_Nbr_Dimensions (Aggr_Type) = 1); @@ -104,7 +96,6 @@ package body Elab.Vhdl_Expr is Els : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); Last : constant Natural := Flist_Last (Els); Bnd : Bound_Type; - Bnds : Bound_Array_Acc; Res_Type : Type_Acc; Val : Valtyp; Res : Valtyp; @@ -116,9 +107,7 @@ package body Elab.Vhdl_Expr is if El_Typ.Kind in Type_Nets then Res_Type := Create_Vector_Type (Bnd, El_Typ); else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res_Type := Create_Array_Type (Bnds, El_Typ); + Res_Type := Create_Array_Type (Bnd, True, El_Typ); end if; Res := Create_Value_Memory (Res_Type); @@ -132,7 +121,7 @@ package body Elab.Vhdl_Expr is end loop; return Res; - end Synth_Simple_Aggregate; + end Exec_Simple_Aggregate; -- Change the bounds of VAL. function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is @@ -221,18 +210,28 @@ package body Elab.Vhdl_Expr is when Type_Array => pragma Assert (Vtype.Kind = Type_Array); -- Check bounds. - for I in Vtype.Abounds.D'Range loop - if Vtype.Abounds.D (I).Len /= Dtype.Abounds.D (I).Len then - Error_Msg_Elab (+Loc, "mismatching array bounds"); - return No_Valtyp; + declare + Src_Typ, Dst_Typ : Type_Acc; + begin + Src_Typ := Vtype; + Dst_Typ := Dtype; + loop + pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); + if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then + Error_Msg_Elab (+Loc, "mismatching array bounds"); + return No_Valtyp; + end if; + exit when Src_Typ.Alast; + Src_Typ := Src_Typ.Arr_El; + Dst_Typ := Dst_Typ.Arr_El; + end loop; + -- TODO: check element. + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; end if; - end loop; - -- TODO: check element. - if Bounds then - return Reshape_Value (Vt, Dtype); - else - return Vt; - end if; + end; when Type_Unbounded_Array => pragma Assert (Vtype.Kind = Type_Array); return Vt; @@ -258,8 +257,8 @@ package body Elab.Vhdl_Expr is end case; end Exec_Subtype_Conversion; - function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp + function Exec_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp is Param : constant Node := Get_Parameter (Attr); Etype : constant Node := Get_Type (Attr); @@ -297,7 +296,7 @@ package body Elab.Vhdl_Expr is end case; return Create_Value_Discrete (Val, Dtype); end; - end Synth_Value_Attribute; + end Exec_Value_Attribute; function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir) return String @@ -355,14 +354,13 @@ package body Elab.Vhdl_Expr is function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp is Len : constant Natural := Str'Length; - Bnd : Bound_Array_Acc; + Bnd : Bound_Type; Typ : Type_Acc; Res : Valtyp; begin - Bnd := Create_Bound_Array (1); - Bnd.D (1) := (Dir => Dir_To, Left => 1, Right => Int32 (Len), - Len => Uns32 (Len)); - Typ := Create_Array_Type (Bnd, Styp.Uarr_El); + Bnd := (Dir => Dir_To, Left => 1, Right => Int32 (Len), + Len => Uns32 (Len)); + Typ := Create_Array_Type (Bnd, True, Styp.Uarr_El); Res := Create_Value_Memory (Typ); for I in Str'Range loop @@ -372,8 +370,8 @@ package body Elab.Vhdl_Expr is return Res; end String_To_Valtyp; - function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp + function Exec_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp is Param : constant Node := Get_Parameter (Attr); Etype : constant Node := Get_Type (Attr); @@ -394,9 +392,9 @@ package body Elab.Vhdl_Expr is Strip_Const (V); return String_To_Valtyp (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype); - end Synth_Image_Attribute; + end Exec_Image_Attribute; - function Synth_Instance_Name_Attribute + function Exec_Instance_Name_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp is Atype : constant Node := Get_Type (Attr); @@ -406,7 +404,7 @@ package body Elab.Vhdl_Expr is begin -- Return a truncated name, as the prefix is not completly known. return String_To_Valtyp (Name.Suffix, Atyp); - end Synth_Instance_Name_Attribute; + end Exec_Instance_Name_Attribute; -- Convert index IDX in PFX to an offset. -- SYN_INST and LOC are used in case of error. @@ -452,8 +450,9 @@ package body Elab.Vhdl_Expr is El_Typ := Typ.Vec_El; Bnd := Typ.Vbound; when Type_Array => + pragma Assert (Typ.Alast); El_Typ := Typ.Arr_El; - Bnd := Typ.Abounds.D (1); + Bnd := Typ.Abound; when others => raise Internal_Error; end case; @@ -463,7 +462,6 @@ package body Elab.Vhdl_Expr is (Btyp : Type_Acc; Bnd : Bound_Type; El_Typ : Type_Acc) return Type_Acc is Res : Type_Acc; - Bnds : Bound_Array_Acc; begin case Btyp.Kind is when Type_Vector => @@ -473,17 +471,13 @@ package body Elab.Vhdl_Expr is pragma Assert (El_Typ.Kind in Type_Nets); Res := Create_Vector_Type (Bnd, Btyp.Uvec_El); when Type_Array => - pragma Assert (Btyp.Abounds.Ndim = 1); + pragma Assert (Btyp.Alast); pragma Assert (Is_Bounded_Type (Btyp.Arr_El)); - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res := Create_Array_Type (Bnds, Btyp.Arr_El); + Res := Create_Array_Type (Bnd, True, Btyp.Arr_El); when Type_Unbounded_Array => pragma Assert (Btyp.Uarr_Ndim = 1); pragma Assert (Is_Bounded_Type (El_Typ)); - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res := Create_Array_Type (Bnds, El_Typ); + Res := Create_Array_Type (Bnd, True, El_Typ); when others => raise Internal_Error; end case; @@ -994,9 +988,9 @@ package body Elab.Vhdl_Expr is return False; end Error_Ieee_Operator; - function Synth_String_Literal - (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) - return Valtyp + function Exec_String_Literal (Syn_Inst : Synth_Instance_Acc; + Str : Node; + Str_Typ : Type_Acc) return Valtyp is pragma Unreferenced (Syn_Inst); pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); @@ -1005,7 +999,6 @@ package body Elab.Vhdl_Expr is Str_Type : constant Node := Get_Type (Str); El_Type : Type_Acc; Bounds : Bound_Type; - Bnds : Bound_Array_Acc; Res_Type : Type_Acc; Res : Valtyp; Pos : Nat8; @@ -1014,7 +1007,7 @@ package body Elab.Vhdl_Expr is when Type_Vector => Bounds := Str_Typ.Vbound; when Type_Array => - Bounds := Str_Typ.Abounds.D (1); + Bounds := Str_Typ.Abound; when Type_Unbounded_Vector | Type_Unbounded_Array => Bounds := Synth_Bounds_From_Length @@ -1027,9 +1020,7 @@ package body Elab.Vhdl_Expr is if El_Type.Kind in Type_Nets then Res_Type := Create_Vector_Type (Bounds, El_Type); else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bounds; - Res_Type := Create_Array_Type (Bnds, El_Type); + Res_Type := Create_Array_Type (Bounds, True, El_Type); end if; Res := Create_Value_Memory (Res_Type); @@ -1044,7 +1035,7 @@ package body Elab.Vhdl_Expr is end loop; return Res; - end Synth_String_Literal; + end Exec_String_Literal; -- Return the left bound if the direction of the range is LEFT_DIR. function Synth_Low_High_Type_Attribute @@ -1246,7 +1237,7 @@ package body Elab.Vhdl_Expr is return Create_Value_Discrete (Get_Physical_Value (Expr), Expr_Type); when Iir_Kind_String_Literal8 => - return Synth_String_Literal (Syn_Inst, Expr, Expr_Type); + return Exec_String_Literal (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Enumeration_Literal => return Exec_Name (Syn_Inst, Expr); when Iir_Kind_Type_Conversion => @@ -1272,7 +1263,7 @@ package body Elab.Vhdl_Expr is when Iir_Kind_Aggregate => return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Simple_Aggregate => - return Synth_Simple_Aggregate (Syn_Inst, Expr); + return Exec_Simple_Aggregate (Syn_Inst, Expr); when Iir_Kind_Parenthesis_Expression => return Exec_Expression_With_Type (Syn_Inst, Get_Expression (Expr), Expr_Type); @@ -1358,11 +1349,11 @@ package body Elab.Vhdl_Expr is when Iir_Kind_High_Type_Attribute => return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto); when Iir_Kind_Value_Attribute => - return Synth_Value_Attribute (Syn_Inst, Expr); + return Exec_Value_Attribute (Syn_Inst, Expr); when Iir_Kind_Image_Attribute => - return Synth_Image_Attribute (Syn_Inst, Expr); + return Exec_Image_Attribute (Syn_Inst, Expr); when Iir_Kind_Instance_Name_Attribute => - return Synth_Instance_Name_Attribute (Syn_Inst, Expr); + return Exec_Instance_Name_Attribute (Syn_Inst, Expr); when Iir_Kind_Null_Literal => return Create_Value_Access (Null_Heap_Index, Expr_Type); when Iir_Kind_Allocator_By_Subtype => diff --git a/src/synth/elab-vhdl_expr.ads b/src/synth/elab-vhdl_expr.ads index 723f5bf91..6427a5de7 100644 --- a/src/synth/elab-vhdl_expr.ads +++ b/src/synth/elab-vhdl_expr.ads @@ -75,4 +75,18 @@ package Elab.Vhdl_Expr is Loc : Node) return Valtyp; + function Exec_String_Literal (Syn_Inst : Synth_Instance_Acc; + Str : Node; + Str_Typ : Type_Acc) return Valtyp; + + function Exec_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp; + function Exec_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp; + function Exec_Instance_Name_Attribute + (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp; + + function Exec_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node) return Valtyp; + end Elab.Vhdl_Expr; diff --git a/src/synth/elab-vhdl_files.adb b/src/synth/elab-vhdl_files.adb index e84c00d42..c974a835d 100644 --- a/src/synth/elab-vhdl_files.adb +++ b/src/synth/elab-vhdl_files.adb @@ -56,13 +56,13 @@ package body Elab.Vhdl_Files is procedure Convert_String (Val : Valtyp; Res : out String) is Vtyp : constant Type_Acc := Val.Typ; - Vlen : constant Uns32 := Vtyp.Abounds.D (1).Len; + Vlen : constant Uns32 := Vtyp.Abound.Len; begin pragma Assert (Vtyp.Kind = Type_Array); pragma Assert (Vtyp.Arr_El.Kind = Type_Discrete); pragma Assert (Vtyp.Arr_El.W in 7 .. 8); -- Could be 7 in vhdl87 - pragma Assert (Vtyp.Abounds.Ndim = 1); - pragma Assert (Vtyp.Abounds.D (1).Len = Res'Length); + pragma Assert (Vtyp.Alast); + pragma Assert (Vtyp.Abound.Len = Res'Length); for I in 1 .. Vlen loop Res (Res'First + Natural (I - 1)) := @@ -79,7 +79,7 @@ package body Elab.Vhdl_Files is Name : constant Valtyp := Strip_Alias_Const (Val); pragma Unreferenced (Val); begin - Len := Natural (Name.Typ.Abounds.D (1).Len); + Len := Natural (Name.Typ.Abound.Len); if Len >= Res'Length - 1 then Status := Op_Filename_Error; @@ -408,7 +408,7 @@ package body Elab.Vhdl_Files is Str : constant Valtyp := Get_Value (Syn_Inst, Param2); Param3 : constant Node := Get_Chain (Param2); Param_Len : constant Valtyp := Get_Value (Syn_Inst, Param3); - Buf : String (1 .. Natural (Str.Typ.Abounds.D (1).Len)); + Buf : String (1 .. Natural (Str.Typ.Abound.Len)); Len : Std_Integer; Status : Op_Status; begin @@ -447,7 +447,7 @@ package body Elab.Vhdl_Files is Off : Size_Type; begin Off := 0; - for I in 1 .. Get_Array_Flat_Length (Val.Typ) loop + for I in 1 .. Get_Bound_Length (Val.Typ) loop File_Read_Value (File, (El_Typ, Val.Mem + Off), Loc); Off := Off + El_Typ.Sz; end loop; @@ -502,7 +502,7 @@ package body Elab.Vhdl_Files is Off : Size_Type; begin Off := 0; - for I in 1 .. Get_Array_Flat_Length (Val.Typ) loop + for I in 1 .. Get_Bound_Length (Val.Typ) loop File_Write_Value (File, (El_Typ, Val.Mem + Off), Loc); Off := Off + El_Typ.Sz; end loop; @@ -542,7 +542,7 @@ package body Elab.Vhdl_Files is Str : Std_String; Bnd : Std_String_Bound; begin - B := Val.Typ.Abounds.D (1); + B := Val.Typ.Abound; Bnd.Dim_1 := (Left => Ghdl_I32 (B.Left), Right => Ghdl_I32 (B.Right), Dir => Dir_To_Dir (B.Dir), diff --git a/src/synth/elab-vhdl_objtypes.adb b/src/synth/elab-vhdl_objtypes.adb index 3715e0532..3040f1874 100644 --- a/src/synth/elab-vhdl_objtypes.adb +++ b/src/synth/elab-vhdl_objtypes.adb @@ -85,14 +85,12 @@ package body Elab.Vhdl_Objtypes is when Type_Slice => return Are_Types_Equal (L.Slice_El, R.Slice_El); when Type_Array => - if L.Abounds.Ndim /= R.Abounds.Ndim then + if L.Alast /= R.Alast then + return False; + end if; + if L.Abound /= R.Abound then return False; end if; - for I in L.Abounds.D'Range loop - if L.Abounds.D (I) /= R.Abounds.D (I) then - return False; - end if; - end loop; return Are_Types_Equal (L.Arr_El, R.Arr_El); when Type_Unbounded_Array => return L.Uarr_Ndim = R.Uarr_Ndim @@ -342,24 +340,20 @@ package body Elab.Vhdl_Objtypes is return To_Bound_Array_Acc (Res); end Create_Bound_Array; - function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) - return Type_Acc + function Create_Array_Type + (Bnd : Bound_Type; Last : Boolean; El_Type : Type_Acc) return Type_Acc is subtype Array_Type_Type is Type_Type (Type_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Array_Type_Type); - L : Uns32; begin - L := 1; - for I in Bnd.D'Range loop - L := L * Bnd.D (I).Len; - end loop; return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Array, Is_Synth => El_Type.Is_Synth, Al => El_Type.Al, - Sz => El_Type.Sz * Size_Type (L), - W => El_Type.W * L, - Abounds => Bnd, + Sz => El_Type.Sz * Size_Type (Bnd.Len), + W => El_Type.W * Bnd.Len, + Abound => Bnd, + Alast => Last, Arr_El => El_Type))); end Create_Array_Type; @@ -420,7 +414,10 @@ package body Elab.Vhdl_Objtypes is end if; return Typ.Vbound; when Type_Array => - return Typ.Abounds.D (Dim); + if Dim /= 1 then + raise Internal_Error; + end if; + return Typ.Abound; when others => raise Internal_Error; end case; @@ -594,10 +591,14 @@ package body Elab.Vhdl_Objtypes is when Type_Array => declare Len : Uns32; + T : Type_Acc; begin Len := 1; - for I in Typ.Abounds.D'Range loop - Len := Len * Typ.Abounds.D (I).Len; + T := Typ; + loop + Len := Len * T.Abound.Len; + exit when T.Alast; + T := T.Arr_El; end loop; return Iir_Index32 (Len); end; @@ -612,21 +613,15 @@ package body Elab.Vhdl_Objtypes is return Atype.W; end Get_Type_Width; - function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32 is + function Get_Bound_Length (T : Type_Acc) return Uns32 is begin case T.Kind is when Type_Vector => - if Dim /= 1 then - raise Internal_Error; - end if; return T.Vbound.Len; when Type_Slice => - if Dim /= 1 then - raise Internal_Error; - end if; return T.W; when Type_Array => - return T.Abounds.D (Dim).Len; + return T.Abound.Len; when others => raise Internal_Error; end case; @@ -643,14 +638,16 @@ package body Elab.Vhdl_Objtypes is return True; when Type_Vector | Type_Slice => - return Get_Bound_Length (L, 1) = Get_Bound_Length (R, 1); + return Get_Bound_Length (L) = Get_Bound_Length (R); when Type_Array => - for I in L.Abounds.D'Range loop - if Get_Bound_Length (L, I) /= Get_Bound_Length (R, I) then - return False; - end if; - end loop; - return True; + pragma Assert (L.Alast = R.Alast); + if Get_Bound_Length (L) /= Get_Bound_Length (R) then + return False; + end if; + if L.Alast then + return True; + end if; + return Get_Bound_Length (L.Arr_El) = Get_Bound_Length (R.Arr_El); when Type_Unbounded_Array | Type_Unbounded_Vector | Type_Unbounded_Record => diff --git a/src/synth/elab-vhdl_objtypes.ads b/src/synth/elab-vhdl_objtypes.ads index 476264f37..d7f246d8e 100644 --- a/src/synth/elab-vhdl_objtypes.ads +++ b/src/synth/elab-vhdl_objtypes.ads @@ -149,7 +149,8 @@ package Elab.Vhdl_Objtypes is when Type_Slice => Slice_El : Type_Acc; when Type_Array => - Abounds : Bound_Array_Acc; + Abound : Bound_Type; + Alast : Boolean; -- True for the last dimension Arr_El : Type_Acc; when Type_Unbounded_Array => Uarr_Ndim : Dim_Type; @@ -212,8 +213,8 @@ package Elab.Vhdl_Objtypes is function Create_Slice_Type (Len : Uns32; El_Type : Type_Acc) return Type_Acc; function Create_Bound_Array (Ndims : Dim_Type) return Bound_Array_Acc; - function Create_Array_Type (Bnd : Bound_Array_Acc; El_Type : Type_Acc) - return Type_Acc; + function Create_Array_Type + (Bnd : Bound_Type; Last : Boolean; El_Type : Type_Acc) return Type_Acc; function Create_Unbounded_Array (Ndim : Dim_Type; El_Type : Type_Acc; Idx1 : Type_Acc) return Type_Acc; function Create_Rec_El_Array (Nels : Iir_Index32) return Rec_El_Array_Acc; @@ -260,7 +261,8 @@ package Elab.Vhdl_Objtypes is function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32; -- Return length of dimension DIM of type T. - function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32; +-- function Get_Bound_Length (T : Type_Acc; Dim : Dim_Type) return Uns32; + function Get_Bound_Length (T : Type_Acc) return Uns32; function Is_Matching_Bounds (L, R : Type_Acc) return Boolean; diff --git a/src/synth/elab-vhdl_types.adb b/src/synth/elab-vhdl_types.adb index ca38e840b..82e63da15 100644 --- a/src/synth/elab-vhdl_types.adb +++ b/src/synth/elab-vhdl_types.adb @@ -482,7 +482,6 @@ package body Elab.Vhdl_Types is Get_Subtype_Object (Syn_Inst, Parent_Type); St_El : Node; El_Typ : Type_Acc; - Bnds : Bound_Array_Acc; begin -- VHDL08 if Has_Element_Subtype_Indication (Atype) then @@ -519,14 +518,19 @@ package body Elab.Vhdl_Types is when Type_Unbounded_Array => -- FIXME: partially constrained arrays, subtype in indexes... if Get_Index_Constraint_Flag (Atype) then - Bnds := Create_Bound_Array - (Dim_Type (Get_Nbr_Elements (St_Indexes))); - for I in Flist_First .. Flist_Last (St_Indexes) loop - St_El := Get_Index_Type (St_Indexes, I); - Bnds.D (Dim_Type (I + 1)) := - Synth_Bounds_From_Range (Syn_Inst, St_El); - end loop; - return Create_Array_Type (Bnds, El_Typ); + declare + Res_Typ : Type_Acc; + Bnd : Bound_Type; + begin + Res_Typ := El_Typ; + for I in reverse Flist_First .. Flist_Last (St_Indexes) loop + St_El := Get_Index_Type (St_Indexes, I); + Bnd := Synth_Bounds_From_Range (Syn_Inst, St_El); + Res_Typ := Create_Array_Type + (Bnd, Res_Typ = El_Typ, Res_Typ); + end loop; + return Res_Typ; + end; else raise Internal_Error; end if; diff --git a/src/synth/elab-vhdl_values-debug.adb b/src/synth/elab-vhdl_values-debug.adb index 15da440e1..2183c436b 100644 --- a/src/synth/elab-vhdl_values-debug.adb +++ b/src/synth/elab-vhdl_values-debug.adb @@ -59,15 +59,20 @@ package body Elab.Vhdl_Values.Debug is Debug_Typ1 (T.Vec_El); Put ("]"); when Type_Array => - Put ("arr ("); - for I in 1 .. T.Abounds.Ndim loop - if I > 1 then + declare + It : Type_Acc; + begin + Put ("arr ("); + It := T; + loop + Debug_Bound (It.Abound, True); + exit when It.Alast; Put (", "); - end if; - Debug_Bound (T.Abounds.D (I), True); - end loop; - Put (") of "); - Debug_Typ1 (T.Arr_El); + It := It.Arr_El; + end loop; + Put (") of "); + Debug_Typ1 (T.Arr_El); + end; when Type_Record => Put ("rec: ("); Put (")"); @@ -128,14 +133,19 @@ package body Elab.Vhdl_Values.Debug is Debug_Bound (T.Vbound, False); Put (")"); when Type_Array => - Put ("arr ("); - for I in 1 .. T.Abounds.Ndim loop - if I > 1 then + declare + It : Type_Acc; + begin + Put ("arr ("); + It := T; + loop + Debug_Bound (It.Abound, False); + exit when It.Alast; + It := It.Arr_El; Put (", "); - end if; - Debug_Bound (T.Abounds.D (I), False); - end loop; - Put (")"); + end loop; + Put (")"); + end; when Type_Record => Put ("rec: ("); Put (")"); @@ -175,21 +185,30 @@ package body Elab.Vhdl_Values.Debug is Put_Uns32 (Uns32 (Read_U8 (M.Mem + Size_Type (I - 1)))); end loop; when Type_Array => - Put ("arr ("); - for I in 1 .. M.Typ.Abounds.Ndim loop - if I > 1 then + declare + T : Type_Acc; + El : Type_Acc; + Len : Uns32; + begin + Put ("arr ("); + T := M.Typ; + Len := 1; + loop + Debug_Bound (T.Abound, True); + Len := Len * T.Abound.Len; + El := T.Arr_El; + exit when T.Alast; + T := El; Put (", "); - end if; - Debug_Bound (M.Typ.Abounds.D (I), True); - end loop; - Put ("): "); - for I in 1 .. Get_Array_Flat_Length (M.Typ) loop - if I > 1 then - Put (", "); - end if; - Debug_Memtyp - ((M.Typ.Arr_El, M.Mem + Size_Type (I - 1) * M.Typ.Arr_El.Sz)); - end loop; + end loop; + Put ("): "); + for I in 1 .. Len loop + if I > 1 then + Put (", "); + end if; + Debug_Memtyp ((El, M.Mem + Size_Type (I - 1) * El.Sz)); + end loop; + end; when Type_Record => Put ("rec: ("); for I in M.Typ.Rec.E'Range loop diff --git a/src/synth/elab-vhdl_values.adb b/src/synth/elab-vhdl_values.adb index 59bc63293..8d14048cb 100644 --- a/src/synth/elab-vhdl_values.adb +++ b/src/synth/elab-vhdl_values.adb @@ -167,26 +167,6 @@ package body Elab.Vhdl_Values is return Iir_Index32 (Typ.Vbound.Len); end Vec_Length; - function Get_Array_Flat_Length (Typ : Type_Acc) return Iir_Index32 is - begin - case Typ.Kind is - when Type_Vector => - return Iir_Index32 (Typ.Vbound.Len); - when Type_Array => - declare - Len : Uns32; - begin - Len := 1; - for I in Typ.Abounds.D'Range loop - Len := Len * Typ.Abounds.D (I).Len; - end loop; - return Iir_Index32 (Len); - end; - when others => - raise Internal_Error; - end case; - end Get_Array_Flat_Length; - function Create_Value_Alias (Obj : Valtyp; Off : Value_Offsets; Typ : Type_Acc) return Valtyp is @@ -413,10 +393,10 @@ package body Elab.Vhdl_Values is raise Internal_Error; when Type_Array => declare - Len : constant Iir_Index32 := Get_Array_Flat_Length (Typ); + Len : constant Uns32 := Get_Bound_Length (Typ); El_Typ : constant Type_Acc := Typ.Arr_El; begin - for I in 1 .. Len loop + for I in 1 .. Iir_Index32 (Len) loop Write_Value_Default (Arr_Index (M, I - 1, El_Typ), El_Typ); end loop; end; @@ -453,7 +433,7 @@ package body Elab.Vhdl_Values is function Value_To_String (Val : Valtyp) return String is - Str : String (1 .. Natural (Val.Typ.Abounds.D (1).Len)); + Str : String (1 .. Natural (Val.Typ.Abound.Len)); begin for I in Str'Range loop Str (Natural (I)) := Character'Val diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index 8a5f4f863..dfb4a78d6 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -196,7 +196,7 @@ package body Synth.Disp_Vhdl is else -- Any array. declare - Bnd : Bound_Type renames Typ.Abounds.D (1); + Bnd : Bound_Type renames Typ.Abound; El_Type : constant Node := Get_Element_Subtype (Ptype); El_W : constant Width := Get_Type_Width (Typ.Arr_El); Idx : Int32; @@ -375,7 +375,7 @@ package body Synth.Disp_Vhdl is Put_Line (");"); else declare - Bnd : Bound_Type renames Typ.Abounds.D (1); + Bnd : Bound_Type renames Typ.Abound; El_Type : constant Node := Get_Element_Subtype (Ptype); El_W : constant Width := Get_Type_Width (Typ.Arr_El); Idx : Int32; diff --git a/src/synth/synth-vhdl_aggr.adb b/src/synth/synth-vhdl_aggr.adb index 6e7d3447f..2115fde07 100644 --- a/src/synth/synth-vhdl_aggr.adb +++ b/src/synth/synth-vhdl_aggr.adb @@ -82,17 +82,29 @@ package body Synth.Vhdl_Aggr is return (1 => 1); when Type_Array => declare - Bnds : constant Bound_Array_Acc := Typ.Abounds; - Res : Stride_Array (1 .. Bnds.Ndim); + T : Type_Acc; + Ndim : Dim_Type; + Res : Stride_Array (1 .. 16); + type Type_Acc_Array is array (Dim_Type range <>) of Type_Acc; + Arr_Typ : Type_Acc_Array (1 .. 16); Stride : Nat32; begin + T := Typ; + -- Compute number of dimensions. + Ndim := 1; + Arr_Typ (Ndim) := T; + while not T.Alast loop + Ndim := Ndim + 1; + T := T.Arr_El; + Arr_Typ (Ndim) := T; + end loop; Stride := 1; - for I in reverse 2 .. Bnds.Ndim loop - Res (Dim_Type (I)) := Stride; - Stride := Stride * Nat32 (Bnds.D (I).Len); + for I in reverse 2 .. Ndim loop + Res (I) := Stride; + Stride := Stride * Nat32 (Arr_Typ (I).Abound.Len); end loop; Res (1) := Stride; - return Res; + return Res (1 .. Ndim); end; when others => raise Internal_Error; @@ -110,7 +122,7 @@ package body Synth.Vhdl_Aggr is Err_P : out boolean) is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Bound : constant Bound_Type := Get_Array_Bound (Typ, Dim); + Bound : constant Bound_Type := Get_Array_Bound (Typ, 1); El_Typ : constant Type_Acc := Get_Array_Element (Typ); Stride : constant Nat32 := Strides (Dim); Value : Node; @@ -126,7 +138,8 @@ package body Synth.Vhdl_Aggr is begin Nbr_Els := Nbr_Els + 1; - if Dim = Strides'Last then + if Typ.Kind = Type_Vector or else Typ.Alast then + pragma Assert (Dim = Strides'Last); Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Typ); Val := Synth_Subtype_Conversion (Ctxt, Val, El_Typ, False, Value); pragma Assert (Res (Pos) = No_Valtyp); @@ -140,7 +153,7 @@ package body Synth.Vhdl_Aggr is end if; else Fill_Array_Aggregate - (Syn_Inst, Value, Res, Typ, Pos, Strides, Dim + 1, + (Syn_Inst, Value, Res, El_Typ, Pos, Strides, Dim + 1, Sub_Const, Sub_Err); Const_P := Const_P and Sub_Const; Err_P := Err_P or Sub_Err; @@ -219,7 +232,7 @@ package body Synth.Vhdl_Aggr is begin Val := Synth_Expression_With_Basetype (Syn_Inst, Value); - Val_Len := Get_Bound_Length (Val.Typ, 1); + Val_Len := Get_Bound_Length (Val.Typ); pragma Assert (Stride = 1); if Pos - First_Pos > Nat32 (Bound.Len - Val_Len) then Error_Msg_Synth @@ -296,7 +309,7 @@ package body Synth.Vhdl_Aggr is (Syn_Inst, Value); -- The length must match the range. Rng_Len := Get_Range_Length (Rng); - if Get_Bound_Length (Val.Typ, 1) /= Rng_Len then + if Get_Bound_Length (Val.Typ) /= Rng_Len then Error_Msg_Synth (+Value, "length doesn't match range"); end if; diff --git a/src/synth/synth-vhdl_eval.adb b/src/synth/synth-vhdl_eval.adb index c6846718d..beb6883ec 100644 --- a/src/synth/synth-vhdl_eval.adb +++ b/src/synth/synth-vhdl_eval.adb @@ -333,9 +333,9 @@ package body Synth.Vhdl_Eval is when Iir_Predefined_Array_Array_Concat => declare L_Len : constant Iir_Index32 := - Iir_Index32 (Get_Bound_Length (Left.Typ, 1)); + Iir_Index32 (Get_Bound_Length (Left.Typ)); R_Len : constant Iir_Index32 := - Iir_Index32 (Get_Bound_Length (Right.Typ, 1)); + Iir_Index32 (Get_Bound_Length (Right.Typ)); Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ); Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); Bnd : Bound_Type; @@ -359,7 +359,7 @@ package body Synth.Vhdl_Eval is when Iir_Predefined_Element_Array_Concat => declare Rlen : constant Iir_Index32 := - Get_Array_Flat_Length (Right.Typ); + Iir_Index32 (Get_Bound_Length (Right.Typ)); Re_Typ : constant Type_Acc := Get_Array_Element (Right.Typ); Bnd : Bound_Type; Res_St : Type_Acc; @@ -378,7 +378,8 @@ package body Synth.Vhdl_Eval is end; when Iir_Predefined_Array_Element_Concat => declare - Llen : constant Iir_Index32 := Get_Array_Flat_Length (Left.Typ); + Llen : constant Iir_Index32 := + Iir_Index32 (Get_Bound_Length (Left.Typ)); Le_Typ : constant Type_Acc := Get_Array_Element (Left.Typ); Bnd : Bound_Type; Res_St : Type_Acc; diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb index cd6a25459..44cb0c781 100644 --- a/src/synth/synth-vhdl_expr.adb +++ b/src/synth/synth-vhdl_expr.adb @@ -17,9 +17,7 @@ -- along with this program. If not, see . with Types_Utils; use Types_Utils; -with Name_Table; with Std_Names; -with Str_Table; with Mutils; use Mutils; with Errorout; use Errorout; @@ -42,6 +40,7 @@ with Netlists.Locations; with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Heap; use Elab.Vhdl_Heap; with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Expr; with Elab.Debugger; with Synth.Errors; use Synth.Errors; @@ -51,9 +50,6 @@ with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; with Synth.Vhdl_Aggr; with Synth.Vhdl_Context; use Synth.Vhdl_Context; -with Grt.Types; -with Grt.To_Strings; - package body Synth.Vhdl_Expr is function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Valtyp; @@ -343,7 +339,7 @@ package body Synth.Vhdl_Expr is end; when Type_Array => declare - Alen : constant Iir_Index32 := Get_Array_Flat_Length (Typ); + Alen : constant Uns32 := Get_Bound_Length (Typ); El_Typ : constant Type_Acc := Typ.Arr_El; begin for I in reverse 1 .. Alen loop @@ -494,80 +490,11 @@ package body Synth.Vhdl_Expr is declare Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); begin - case Bnds.Kind is - when Type_Vector => - pragma Assert (Dim = 1); - return Bnds.Vbound; - when Type_Array => - return Bnds.Abounds.D (Dim); - when others => - raise Internal_Error; - end case; + return Get_Array_Bound (Bnds, Dim); end; end if; end Synth_Array_Bounds; - function Synth_Bounds_From_Length (Atype : Node; Len : Int32) - return Bound_Type - is - Rng : constant Node := Get_Range_Constraint (Atype); - Limit : Int32; - begin - Limit := Int32 (Eval_Pos (Get_Left_Limit (Rng))); - case Get_Direction (Rng) is - when Dir_To => - return (Dir => Dir_To, - Left => Limit, - Right => Limit + Len - 1, - Len => Uns32 (Len)); - when Dir_Downto => - return (Dir => Dir_Downto, - Left => Limit, - Right => Limit - Len + 1, - Len => Uns32 (Len)); - end case; - end Synth_Bounds_From_Length; - - function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node) return Valtyp - is - Aggr_Type : constant Node := Get_Type (Aggr); - pragma Assert (Get_Nbr_Dimensions (Aggr_Type) = 1); - El_Type : constant Node := Get_Element_Subtype (Aggr_Type); - El_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, El_Type); - Els : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); - Last : constant Natural := Flist_Last (Els); - Bnd : Bound_Type; - Bnds : Bound_Array_Acc; - Res_Type : Type_Acc; - Val : Valtyp; - Res : Valtyp; - begin - -- Allocate the result. - Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 1); - pragma Assert (Bnd.Len = Uns32 (Last + 1)); - - if El_Typ.Kind in Type_Nets then - Res_Type := Create_Vector_Type (Bnd, El_Typ); - else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bnd; - Res_Type := Create_Array_Type (Bnds, El_Typ); - end if; - - Res := Create_Value_Memory (Res_Type); - - for I in Flist_First .. Last loop - -- Elements are supposed to be static, so no need for enable. - Val := Synth_Expression_With_Type - (Syn_Inst, Get_Nth_Element (Els, I), El_Typ); - pragma Assert (Is_Static (Val.Val)); - Write_Value (Res.Val.Mem + Size_Type (I) * El_Typ.Sz, Val); - end loop; - - return Res; - end Synth_Simple_Aggregate; - -- Change the bounds of VAL. function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is begin @@ -683,18 +610,28 @@ package body Synth.Vhdl_Expr is when Type_Array => pragma Assert (Vtype.Kind = Type_Array); -- Check bounds. - for I in Vtype.Abounds.D'Range loop - if Vtype.Abounds.D (I).Len /= Dtype.Abounds.D (I).Len then - Error_Msg_Synth (+Loc, "mismatching array bounds"); - return No_Valtyp; + declare + Src_Typ, Dst_Typ : Type_Acc; + begin + Src_Typ := Vtype; + Dst_Typ := Dtype; + loop + pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); + if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then + Error_Msg_Synth (+Loc, "mismatching array bounds"); + return No_Valtyp; + end if; + exit when Src_Typ.Alast; + Src_Typ := Src_Typ.Arr_El; + Dst_Typ := Dst_Typ.Arr_El; + end loop; + -- TODO: check element. + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; end if; - end loop; - -- TODO: check element. - if Bounds then - return Reshape_Value (Vt, Dtype); - else - return Vt; - end if; + end; when Type_Unbounded_Array => pragma Assert (Vtype.Kind = Type_Array); return Vt; @@ -732,156 +669,6 @@ package body Synth.Vhdl_Expr is return Synth_Subtype_Conversion (Ctxt, Vt, Dtype, Bounds, Loc); end Synth_Subtype_Conversion; - function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp - is - Param : constant Node := Get_Parameter (Attr); - Etype : constant Node := Get_Type (Attr); - Btype : constant Node := Get_Base_Type (Etype); - V : Valtyp; - Dtype : Type_Acc; - begin - -- The value is supposed to be static. - V := Synth_Expression (Syn_Inst, Param); - if V = No_Valtyp then - return No_Valtyp; - end if; - - Dtype := Get_Subtype_Object (Syn_Inst, Etype); - if not Is_Static (V.Val) then - Error_Msg_Synth (+Attr, "parameter of 'value must be static"); - return No_Valtyp; - end if; - - declare - Str : constant String := Value_To_String (V); - Res_N : Node; - Val : Int64; - begin - case Get_Kind (Btype) is - when Iir_Kind_Enumeration_Type_Definition => - Res_N := Eval_Value_Attribute (Str, Etype, Attr); - Val := Int64 (Get_Enum_Pos (Res_N)); - Free_Iir (Res_N); - when Iir_Kind_Integer_Type_Definition => - Val := Int64'Value (Str); - when others => - Error_Msg_Synth (+Attr, "unhandled type for 'value"); - return No_Valtyp; - end case; - return Create_Value_Discrete (Val, Dtype); - end; - end Synth_Value_Attribute; - - function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir) - return String - is - use Grt.Types; - begin - case Get_Kind (Expr_Type) is - when Iir_Kind_Floating_Type_Definition - | Iir_Kind_Floating_Subtype_Definition => - declare - Str : String (1 .. 24); - Last : Natural; - begin - Grt.To_Strings.To_String - (Str, Last, Ghdl_F64 (Read_Fp64 (Val))); - return Str (Str'First .. Last); - end; - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Integer_Subtype_Definition => - declare - Str : String (1 .. 21); - First : Natural; - begin - Grt.To_Strings.To_String - (Str, First, Ghdl_I64 (Read_Discrete (Val))); - return Str (First .. Str'Last); - end; - when Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - declare - Lits : constant Iir_Flist := - Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type)); - begin - return Name_Table.Image - (Get_Identifier - (Get_Nth_Element (Lits, Natural (Read_Discrete (Val))))); - end; - when Iir_Kind_Physical_Type_Definition - | Iir_Kind_Physical_Subtype_Definition => - declare - Str : String (1 .. 21); - First : Natural; - Id : constant Name_Id := - Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type))); - begin - Grt.To_Strings.To_String - (Str, First, Ghdl_I64 (Read_Discrete (Val))); - return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); - end; - when others => - Error_Kind ("execute_image_attribute", Expr_Type); - end case; - end Synth_Image_Attribute_Str; - - function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp - is - Len : constant Natural := Str'Length; - Bnd : Bound_Array_Acc; - Typ : Type_Acc; - Res : Valtyp; - begin - Bnd := Create_Bound_Array (1); - Bnd.D (1) := (Dir => Dir_To, Left => 1, Right => Int32 (Len), - Len => Width (Len)); - Typ := Create_Array_Type (Bnd, Styp.Uarr_El); - - Res := Create_Value_Memory (Typ); - for I in Str'Range loop - Write_U8 (Res.Val.Mem + Size_Type (I - Str'First), - Character'Pos (Str (I))); - end loop; - return Res; - end String_To_Valtyp; - - function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Valtyp - is - Param : constant Node := Get_Parameter (Attr); - Etype : constant Node := Get_Type (Attr); - V : Valtyp; - Dtype : Type_Acc; - begin - -- The parameter is expected to be static. - V := Synth_Expression (Syn_Inst, Param); - if V = No_Valtyp then - return No_Valtyp; - end if; - Dtype := Get_Subtype_Object (Syn_Inst, Etype); - if not Is_Static (V.Val) then - Error_Msg_Synth (+Attr, "parameter of 'image must be static"); - return No_Valtyp; - end if; - - Strip_Const (V); - return String_To_Valtyp - (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype); - end Synth_Image_Attribute; - - function Synth_Instance_Name_Attribute - (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp - is - Atype : constant Node := Get_Type (Attr); - Atyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); - Name : constant Path_Instance_Name_Type := - Get_Path_Instance_Name_Suffix (Attr); - begin - -- Return a truncated name, as the prefix is not completly known. - return String_To_Valtyp (Name.Suffix, Atyp); - end Synth_Instance_Name_Attribute; - function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Valtyp is begin @@ -996,74 +783,95 @@ package body Synth.Vhdl_Expr is return Off; end Dyn_Index_To_Offset; - procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; - Name : Node; - Pfx_Type : Type_Acc; - Voff : out Net; - Off : out Value_Offsets; - Error : out Boolean) + procedure Synth_Indexes (Syn_Inst : Synth_Instance_Acc; + Indexes : Iir_Flist; + Dim : Natural; + Arr_Typ : Type_Acc; + El_Typ : out Type_Acc; + Voff : out Net; + Off : out Value_Offsets; + Stride : out Uns32; + Error : out Boolean) is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Indexes : constant Iir_Flist := Get_Index_List (Name); - El_Typ : constant Type_Acc := Get_Array_Element (Pfx_Type); Idx_Expr : Node; Idx_Val : Valtyp; Idx : Int64; Bnd : Bound_Type; - Stride : Uns32; Ivoff : Net; Idx_Off : Value_Offsets; begin - Voff := No_Net; - Off := (0, 0); - Error := False; + if Dim > Flist_Last (Indexes) then + Voff := No_Net; + Off := (0, 0); + Error := False; + Stride := 1; + El_Typ := Arr_Typ; + return; + else + Synth_Indexes + (Syn_Inst, Indexes, Dim + 1, Get_Array_Element (Arr_Typ), + El_Typ, Voff, Off, Stride, Error); + end if; - Stride := 1; - for I in reverse Flist_First .. Flist_Last (Indexes) loop - Idx_Expr := Get_Nth_Element (Indexes, I); + Idx_Expr := Get_Nth_Element (Indexes, Dim); - -- Use the base type as the subtype of the index is not synth-ed. - Idx_Val := Synth_Expression_With_Basetype (Syn_Inst, Idx_Expr); - if Idx_Val = No_Valtyp then - -- Propagate error. - Error := True; - return; - end if; + -- Use the base type as the subtype of the index is not synth-ed. + Idx_Val := Synth_Expression_With_Basetype (Syn_Inst, Idx_Expr); + if Idx_Val = No_Valtyp then + -- Propagate error. + Error := True; + return; + end if; - Strip_Const (Idx_Val); + Strip_Const (Idx_Val); - Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1)); + Bnd := Get_Array_Bound (Arr_Typ, 1); - if Is_Static_Val (Idx_Val.Val) then - Idx := Get_Static_Discrete (Idx_Val); - if not In_Bounds (Bnd, Int32 (Idx)) then - Bound_Error (Syn_Inst, Name); - Error := True; - else - Idx_Off := Index_To_Offset (Syn_Inst, Bnd, Idx, Name); - Off.Net_Off := Off.Net_Off - + Idx_Off.Net_Off * Stride * El_Typ.W; - Off.Mem_Off := Off.Mem_Off - + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz; - end if; + if Is_Static_Val (Idx_Val.Val) then + Idx := Get_Static_Discrete (Idx_Val); + if not In_Bounds (Bnd, Int32 (Idx)) then + Bound_Error (Syn_Inst, Idx_Expr); + Error := True; else - Ivoff := Dyn_Index_To_Offset (Ctxt, Bnd, Idx_Val, Name); - Ivoff := Build_Memidx - (Get_Build (Syn_Inst), Ivoff, El_Typ.W * Stride, - Bnd.Len - 1, - Width (Clog2 (Uns64 (El_Typ.W * Stride * Bnd.Len)))); - Set_Location (Ivoff, Idx_Expr); - - if Voff = No_Net then - Voff := Ivoff; - else - Voff := Build_Addidx (Get_Build (Syn_Inst), Ivoff, Voff); - Set_Location (Voff, Idx_Expr); - end if; + Idx_Off := Index_To_Offset (Syn_Inst, Bnd, Idx, Idx_Expr); + Off.Net_Off := Off.Net_Off + + Idx_Off.Net_Off * Stride * El_Typ.W; + Off.Mem_Off := Off.Mem_Off + + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz; + end if; + else + Ivoff := Dyn_Index_To_Offset (Ctxt, Bnd, Idx_Val, Idx_Expr); + Ivoff := Build_Memidx + (Get_Build (Syn_Inst), Ivoff, El_Typ.W * Stride, + Bnd.Len - 1, + Width (Clog2 (Uns64 (El_Typ.W * Stride * Bnd.Len)))); + Set_Location (Ivoff, Idx_Expr); + + if Voff = No_Net then + Voff := Ivoff; + else + Voff := Build_Addidx (Get_Build (Syn_Inst), Ivoff, Voff); + Set_Location (Voff, Idx_Expr); end if; + end if; - Stride := Stride * Bnd.Len; - end loop; + Stride := Stride * Bnd.Len; + end Synth_Indexes; + + procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Type : Type_Acc; + El_Typ : out Type_Acc; + Voff : out Net; + Off : out Value_Offsets; + Error : out Boolean) + is + Indexes : constant Iir_Flist := Get_Index_List (Name); + Stride : Uns32; + begin + Synth_Indexes (Syn_Inst, Indexes, Flist_First, Pfx_Type, + El_Typ, Voff, Off, Stride, Error); end Synth_Indexed_Name; function Is_Static (N : Net) return Boolean is @@ -1672,58 +1480,6 @@ package body Synth.Vhdl_Expr is return False; end Error_Ieee_Operator; - function Synth_String_Literal - (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) - return Valtyp - is - pragma Unreferenced (Syn_Inst); - pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); - Id : constant String8_Id := Get_String8_Id (Str); - - Str_Type : constant Node := Get_Type (Str); - El_Type : Type_Acc; - Bounds : Bound_Type; - Bnds : Bound_Array_Acc; - Res_Type : Type_Acc; - Res : Valtyp; - Pos : Nat8; - begin - case Str_Typ.Kind is - when Type_Vector => - Bounds := Str_Typ.Vbound; - when Type_Array => - Bounds := Str_Typ.Abounds.D (1); - when Type_Unbounded_Vector - | Type_Unbounded_Array => - Bounds := Synth_Bounds_From_Length - (Get_Index_Type (Str_Type, 0), Get_String_Length (Str)); - when others => - raise Internal_Error; - end case; - - El_Type := Get_Array_Element (Str_Typ); - if El_Type.Kind in Type_Nets then - Res_Type := Create_Vector_Type (Bounds, El_Type); - else - Bnds := Create_Bound_Array (1); - Bnds.D (1) := Bounds; - Res_Type := Create_Array_Type (Bnds, El_Type); - end if; - Res := Create_Value_Memory (Res_Type); - - -- Only U8 are handled. - pragma Assert (El_Type.Sz = 1); - - -- From left to right. - for I in 1 .. Bounds.Len loop - -- FIXME: use literal from type ?? - Pos := Str_Table.Element_String8 (Id, Pos32 (I)); - Write_U8 (Res.Val.Mem + Size_Type (I - 1), Nat8'Pos (Pos)); - end loop; - - return Res; - end Synth_String_Literal; - -- Return the left bound if the direction of the range is LEFT_DIR. function Synth_Low_High_Type_Attribute (Syn_Inst : Synth_Instance_Acc; Expr : Node; Left_Dir : Direction_Type) @@ -2281,7 +2037,8 @@ package body Synth.Vhdl_Expr is return Create_Value_Discrete (Get_Physical_Value (Expr), Expr_Type); when Iir_Kind_String_Literal8 => - return Synth_String_Literal (Syn_Inst, Expr, Expr_Type); + return Elab.Vhdl_Expr.Exec_String_Literal + (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Enumeration_Literal => return Synth_Name (Syn_Inst, Expr); when Iir_Kind_Type_Conversion => @@ -2307,7 +2064,7 @@ package body Synth.Vhdl_Expr is when Iir_Kind_Aggregate => return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); when Iir_Kind_Simple_Aggregate => - return Synth_Simple_Aggregate (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Simple_Aggregate (Syn_Inst, Expr); when Iir_Kind_Parenthesis_Expression => return Synth_Expression_With_Type (Syn_Inst, Get_Expression (Expr), Expr_Type); @@ -2394,11 +2151,12 @@ package body Synth.Vhdl_Expr is when Iir_Kind_High_Type_Attribute => return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto); when Iir_Kind_Value_Attribute => - return Synth_Value_Attribute (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Value_Attribute (Syn_Inst, Expr); when Iir_Kind_Image_Attribute => - return Synth_Image_Attribute (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Image_Attribute (Syn_Inst, Expr); when Iir_Kind_Instance_Name_Attribute => - return Synth_Instance_Name_Attribute (Syn_Inst, Expr); + return Elab.Vhdl_Expr.Exec_Instance_Name_Attribute + (Syn_Inst, Expr); when Iir_Kind_Null_Literal => return Create_Value_Access (Null_Heap_Index, Expr_Type); when Iir_Kind_Allocator_By_Subtype => diff --git a/src/synth/synth-vhdl_expr.ads b/src/synth/synth-vhdl_expr.ads index 0aacd8cbf..8f1edd5f3 100644 --- a/src/synth/synth-vhdl_expr.ads +++ b/src/synth/synth-vhdl_expr.ads @@ -115,6 +115,7 @@ package Synth.Vhdl_Expr is procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node; Pfx_Type : Type_Acc; + El_Typ : out Type_Acc; Voff : out Net; Off : out Value_Offsets; Error : out Boolean); diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb index 458981f37..13ebed7f1 100644 --- a/src/synth/synth-vhdl_insts.adb +++ b/src/synth/synth-vhdl_insts.adb @@ -188,9 +188,16 @@ package body Synth.Vhdl_Insts is when Type_Vector => Hash_Bound (C, Typ.Vbound); when Type_Array => - for I in Typ.Abounds.D'Range loop - Hash_Bound (C, Typ.Abounds.D (I)); - end loop; + declare + T : Type_Acc; + begin + T := Typ; + loop + Hash_Bound (C, T.Abound); + exit when T.Alast; + T := T.Arr_El; + end loop; + end; when others => raise Internal_Error; end case; @@ -648,18 +655,20 @@ package body Synth.Vhdl_Insts is end; when Iir_Kind_Indexed_Name => declare + El_Typ : Type_Acc; Voff : Net; Arr_Off : Value_Offsets; Err : Boolean; begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); - Synth_Indexed_Name (Syn_Inst, Formal, Typ, Voff, Arr_Off, Err); + Synth_Indexed_Name (Syn_Inst, Formal, Typ, + El_Typ, Voff, Arr_Off, Err); if Voff /= No_Net or Err then raise Internal_Error; end if; Off := Off + Arr_Off.Net_Off; - Typ := Get_Array_Element (Typ); + Typ := El_Typ; end; when Iir_Kind_Slice_Name => declare diff --git a/src/synth/synth-vhdl_oper.adb b/src/synth/synth-vhdl_oper.adb index 813a5513d..5326f72a0 100644 --- a/src/synth/synth-vhdl_oper.adb +++ b/src/synth/synth-vhdl_oper.adb @@ -974,7 +974,7 @@ package body Synth.Vhdl_Oper is Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Bound_Length (Left.Typ, 1) + 1)); + Iir_Index32 (Get_Bound_Length (Left.Typ) + 1)); Res_Typ := Create_Onedimensional_Array_Subtype (Left_Typ, Bnd, Le_Typ); @@ -994,7 +994,7 @@ package body Synth.Vhdl_Oper is Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Bound_Length (Right.Typ, 1) + 1)); + Iir_Index32 (Get_Bound_Length (Right.Typ) + 1)); Res_Typ := Create_Onedimensional_Array_Subtype (Right_Typ, Bnd, Re_Typ); @@ -1032,8 +1032,8 @@ package body Synth.Vhdl_Oper is Bnd := Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Bound_Length (Left.Typ, 1) - + Get_Bound_Length (Right.Typ, 1))); + Iir_Index32 (Get_Bound_Length (Left.Typ) + + Get_Bound_Length (Right.Typ))); Res_Typ := Create_Onedimensional_Array_Subtype (Expr_Typ, Bnd, Le_Typ); diff --git a/src/synth/synth-vhdl_stmts.adb b/src/synth/synth-vhdl_stmts.adb index 4e2e183c4..14302134d 100644 --- a/src/synth/synth-vhdl_stmts.adb +++ b/src/synth/synth-vhdl_stmts.adb @@ -142,6 +142,7 @@ package body Synth.Vhdl_Stmts is when Iir_Kind_Indexed_Name => declare + El_Typ : Type_Acc; Voff : Net; Off : Value_Offsets; Err : Boolean; @@ -150,7 +151,8 @@ package body Synth.Vhdl_Stmts is (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off, Dest_Dyn); Strip_Const (Dest_Base); - Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Voff, Off, Err); + Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, + El_Typ, Voff, Off, Err); if Err then Dest_Base := No_Valtyp; @@ -179,7 +181,7 @@ package body Synth.Vhdl_Stmts is end if; end if; - Dest_Typ := Get_Array_Element (Dest_Typ); + Dest_Typ := El_Typ; end; when Iir_Kind_Selected_Element => -- cgit v1.2.3