From 1e1eab735ecad00ee663a68e3a5118e041c20739 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sun, 8 Sep 2019 08:00:42 +0200 Subject: synth: Add width field in type_type record. --- src/synth/synth-context.adb | 6 +-- src/synth/synth-decls.adb | 15 ++++-- src/synth/synth-disp_vhdl.adb | 8 ++-- src/synth/synth-expr.adb | 109 ++++++++++++++++-------------------------- src/synth/synth-values.adb | 81 ++++++++++++++++++++----------- src/synth/synth-values.ads | 9 ++-- 6 files changed, 119 insertions(+), 109 deletions(-) diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index d7af882b5..12ad60ed4 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -290,7 +290,7 @@ package body Synth.Context is Off := Off + 1; end; when Type_Discrete => - for I in reverse 0 .. Val.Typ.Drange.W - 1 loop + for I in reverse 0 .. Val.Typ.W - 1 loop declare B : constant Uns32 := Uns32 (Shift_Right (To_Uns64 (Val.Scal), Natural (I))) @@ -381,9 +381,9 @@ package body Synth.Context is Value2net (Val, 1, V, Res); return Res; end; - elsif Val.Typ.Drange.W <= 32 then + elsif Val.Typ.W <= 32 then return Build_Const_UB32 - (Build_Context, Uns32 (Val.Scal), Val.Typ.Drange.W); + (Build_Context, Uns32 (Val.Scal), Val.Typ.W); else raise Internal_Error; end if; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index d411ded68..20bd9323b 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -105,13 +105,14 @@ package body Synth.Decls is Nbr_El : constant Natural := Get_Nbr_Elements (Get_Enumeration_Literal_List (Def)); Rng : Discrete_Range_Type; + W : Width; begin + W := Uns32 (Clog2 (Uns64 (Nbr_El))); Rng := (Dir => Iir_Downto, Is_Signed => False, - W => Uns32 (Clog2 (Uns64 (Nbr_El))), Left => Int64 (Nbr_El - 1), Right => 0); - Typ := Create_Discrete_Type (Rng); + Typ := Create_Discrete_Type (Rng, W); end; end if; Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); @@ -146,7 +147,7 @@ package body Synth.Decls is Typ => El_Typ); Off := Off + Get_Type_Width (El_Typ); end loop; - Typ.Rec_W := Off; + Typ.W := Off; end; when others => Error_Kind ("synth_type_definition", Def); @@ -165,12 +166,14 @@ package body Synth.Decls is Cst : constant Node := Get_Range_Constraint (St); L, R : Int64; Rng : Discrete_Range_Type; + W : Width; begin L := Get_Value (Get_Left_Limit (Cst)); R := Get_Value (Get_Right_Limit (Cst)); Rng := Synth_Discrete_Range_Expression (L, R, Get_Direction (Cst)); - Typ := Create_Discrete_Type (Rng); + W := Discrete_Range_Width (Rng); + Typ := Create_Discrete_Type (Rng, W); Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); end; when Iir_Kind_Floating_Type_Definition => @@ -274,6 +277,7 @@ package body Synth.Decls is Btype : constant Type_Acc := Get_Value_Type (Syn_Inst, Get_Base_Type (Atype)); Rng : Discrete_Range_Type; + W : Width; begin if Btype.Kind = Type_Bit then -- A subtype of a bit type is still a bit. @@ -281,7 +285,8 @@ package body Synth.Decls is else Rng := Synth_Discrete_Range_Constraint (Syn_Inst, Get_Range_Constraint (Atype)); - Typ := Create_Discrete_Type (Rng); + W := Discrete_Range_Width (Rng); + Typ := Create_Discrete_Type (Rng, W); end if; end; when Iir_Kind_Floating_Subtype_Definition => diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index f678c367f..61bf31534 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -97,7 +97,7 @@ package body Synth.Disp_Vhdl is else -- Any other enum. -- TODO: width = 1 - W := Typ.Drange.W; + W := Typ.W; Disp_In_Lhs (Mname, Off, W, Full); Put ("std_logic_vector(to_unsigned("); Put (Name_Table.Image (Get_Identifier @@ -107,7 +107,7 @@ package body Synth.Disp_Vhdl is end if; when Iir_Kind_Integer_Type_Definition => -- FIXME: signed or unsigned ? - W := Typ.Drange.W; + W := Typ.W; Disp_In_Lhs (Mname, Off, W, Full); if W > 1 then Put ("std_logic_vector("); @@ -211,7 +211,7 @@ package body Synth.Disp_Vhdl is Put_Line (";"); else -- Any other enum. - W := Typ.Drange.W; + W := Typ.W; Put (" " & Pfx & " <= "); Put (Name_Table.Image (Get_Identifier (Get_Type_Declarator (Ptype)))); @@ -221,7 +221,7 @@ package body Synth.Disp_Vhdl is end if; when Iir_Kind_Integer_Type_Definition => -- FIXME: signed or unsigned ? - W := Typ.Drange.W; + W := Typ.W; Put (" " & Pfx & " <= to_integer (unsigned"); if W = 1 then Put ("'(0 => "); diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index d0abeec7b..b68637498 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -228,7 +228,7 @@ package body Synth.Expr is -- 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; + Wn : constant Width := Val.Typ.W; N : Net; Res : Net; begin @@ -547,49 +547,12 @@ package body Synth.Expr is end Vectorize_Array; function Synth_Discrete_Range_Expression - (L : Int64; R : Int64; Dir : Iir_Direction) return Discrete_Range_Type - is - V : Discrete_Range_Type; - Lo, Hi : Int64; + (L : Int64; R : Int64; Dir : Iir_Direction) return Discrete_Range_Type is begin - V.Dir := Dir; - V.Left := L; - V.Right := R; - - case V.Dir is - when Iir_To => - Lo := V.Left; - Hi := V.Right; - when Iir_Downto => - Lo := V.Right; - Hi := V.Left; - end case; - if Lo > Hi then - -- Null range. - V.Is_Signed := False; - V.W := 0; - elsif Lo >= 0 then - -- Positive. - V.Is_Signed := False; - V.W := Width (Clog2 (Uns64 (Hi) + 1)); - elsif Lo = Int64'First then - -- Handle possible overflow. - V.Is_Signed := True; - V.W := 64; - elsif Hi < 0 then - -- Negative only. - V.Is_Signed := True; - V.W := Width (Clog2 (Uns64 (-Lo))) + 1; - else - declare - Wl : constant Width := Width (Clog2 (Uns64 (-Lo))); - Wh : constant Width := Width (Clog2 (Uns64 (Hi))); - begin - V.Is_Signed := True; - V.W := Width'Max (Wl, Wh) + 1; - end; - end if; - return V; + return (Dir => Dir, + Left => L, + Right => R, + Is_Signed => L < 0 or R < 0); end Synth_Discrete_Range_Expression; function Synth_Discrete_Range_Expression @@ -605,8 +568,10 @@ package body Synth.Expr is raise Internal_Error; end if; - return Synth_Discrete_Range_Expression - (L.Scal, R.Scal, Get_Direction (Rng)); + return (Dir => Get_Direction (Rng), + Left => L.Scal, + Right => R.Scal, + Is_Signed => L.Scal < 0 or R.Scal < 0); end Synth_Discrete_Range_Expression; function Synth_Float_Range_Expression @@ -639,31 +604,40 @@ package body Synth.Expr is end if; end Synth_Array_Attribute; - function Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; Bound : Node) - return Discrete_Range_Type is + procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; + Bound : Node; + Rng : out Discrete_Range_Type; + W : out Width) is begin case Get_Kind (Bound) is when Iir_Kind_Range_Expression => - return Synth_Discrete_Range_Expression (Syn_Inst, Bound); + Rng := Synth_Discrete_Range_Expression (Syn_Inst, Bound); + W := Discrete_Range_Width (Rng); when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition => if Get_Type_Declarator (Bound) /= Null_Node then - -- This is a named subtype, so it has been evaluated. - return Get_Value_Type (Syn_Inst, Bound).Drange; + declare + Typ : Type_Acc; + begin + -- This is a named subtype, so it has been evaluated. + Typ := Get_Value_Type (Syn_Inst, Bound); + Rng := Typ.Drange; + W := Typ.W; + end; else - return Synth_Discrete_Range - (Syn_Inst, Get_Range_Constraint (Bound)); + Synth_Discrete_Range + (Syn_Inst, Get_Range_Constraint (Bound), Rng, W); end if; when Iir_Kind_Range_Array_Attribute => declare B : Bound_Type; begin B := Synth_Array_Attribute (Syn_Inst, Bound); - return Discrete_Range_Type'(Dir => B.Dir, + Rng := Discrete_Range_Type'(Dir => B.Dir, Is_Signed => True, - W => B.Wbounds, Left => Int64 (B.Left), Right => Int64 (B.Right)); + W := B.Wbounds; end; when others => Error_Kind ("synth_discrete_range", Bound); @@ -704,9 +678,10 @@ package body Synth.Expr is Atype : Node) return Bound_Type is Rng : Discrete_Range_Type; + W : Width; Len : Int64; begin - Rng := Synth_Discrete_Range (Syn_Inst, Atype); + Synth_Discrete_Range (Syn_Inst, Atype, Rng, W); case Rng.Dir is when Iir_To => Len := Rng.Right - Rng.Left + 1; @@ -718,7 +693,7 @@ package body Synth.Expr is end if; return (Dir => Rng.Dir, Wlen => Width (Clog2 (Uns64 (Len))), - Wbounds => Rng.W, + Wbounds => W, Left => Int32 (Rng.Left), Right => Int32 (Rng.Right), Len => Uns32 (Len)); end Synth_Bounds_From_Range; @@ -851,13 +826,14 @@ package body Synth.Expr is is Res : Bound_Type; Index_Bounds : Discrete_Range_Type; + W : Width; begin - Index_Bounds := Synth_Discrete_Range (Syn_Inst, Atype); + Synth_Discrete_Range (Syn_Inst, Atype, Index_Bounds, W); Res := (Left => Int32 (Index_Bounds.Left), Right => 0, Dir => Index_Bounds.Dir, - Wbounds => Index_Bounds.W, + Wbounds => W, Wlen => Width (Clog2 (Uns64 (Len))), Len => Uns32 (Len)); @@ -894,18 +870,17 @@ package body Synth.Expr is when Type_Discrete => pragma Assert (Vtype.Kind = Type_Discrete); declare - Vrng : Discrete_Range_Type renames Vtype.Drange; - Drng : Discrete_Range_Type renames Dtype.Drange; N : Net; begin - if Vrng.W > Drng.W then + if Vtype.W > Dtype.W then -- Truncate. -- TODO: check overflow. case Val.Kind is when Value_Net | Value_Wire => N := Get_Net (Val); - N := Build_Trunc (Build_Context, Id_Utrunc, N, Drng.W); + N := Build_Trunc + (Build_Context, Id_Utrunc, N, Dtype.W); Set_Location (N, Loc); return Create_Value_Net (N, Dtype); when Value_Discrete => @@ -913,7 +888,7 @@ package body Synth.Expr is when others => raise Internal_Error; end case; - elsif Vrng.W < Drng.W then + elsif Vtype.W < Dtype.W then -- Extend. case Val.Kind is when Value_Discrete => @@ -921,12 +896,12 @@ package body Synth.Expr is when Value_Net | Value_Wire => N := Get_Net (Val); - if Vrng.Is_Signed then + if Vtype.Drange.Is_Signed then N := Build_Extend - (Build_Context, Id_Sextend, N, Drng.W); + (Build_Context, Id_Sextend, N, Dtype.W); else N := Build_Extend - (Build_Context, Id_Uextend, N, Drng.W); + (Build_Context, Id_Uextend, N, Dtype.W); end if; Set_Location (N, Loc); return Create_Value_Net (N, Dtype); @@ -2261,7 +2236,7 @@ package body Synth.Expr is begin return Create_Value_Net (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)), - Nat_Type.Drange.W, Expr), + Nat_Type.W, Expr), Nat_Type); end; when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat => diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 6265a64dd..e199d8698 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -20,7 +20,7 @@ with Ada.Unchecked_Conversion; with System; -with Mutils; +with Mutils; use Mutils; package body Synth.Values is function To_Bound_Array_Acc is new Ada.Unchecked_Conversion @@ -52,20 +52,58 @@ package body Synth.Values is end case; end Is_Equal; + function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width + is + Lo, Hi : Int64; + W : Width; + begin + case Rng.Dir is + when Iir_To => + Lo := Rng.Left; + Hi := Rng.Right; + when Iir_Downto => + Lo := Rng.Right; + Hi := Rng.Left; + end case; + if Lo > Hi then + -- Null range. + W := 0; + elsif Lo >= 0 then + -- Positive. + W := Width (Clog2 (Uns64 (Hi) + 1)); + elsif Lo = Int64'First then + -- Handle possible overflow. + W := 64; + elsif Hi < 0 then + -- Negative only. + W := Width (Clog2 (Uns64 (-Lo))) + 1; + else + declare + Wl : constant Width := Width (Clog2 (Uns64 (-Lo))); + Wh : constant Width := Width (Clog2 (Uns64 (Hi))); + begin + W := Width'Max (Wl, Wh) + 1; + end; + end if; + return W; + end Discrete_Range_Width; + function Create_Bit_Type return Type_Acc is subtype Bit_Type_Type is Type_Type (Type_Bit); function Alloc is new Areapools.Alloc_On_Pool_Addr (Bit_Type_Type); begin - return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit))); + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Bit, W => 1))); end Create_Bit_Type; - function Create_Discrete_Type (Rng : Discrete_Range_Type) return Type_Acc + function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width) + return Type_Acc is subtype Discrete_Type_Type is Type_Type (Type_Discrete); function Alloc is new Areapools.Alloc_On_Pool_Addr (Discrete_Type_Type); begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Discrete, + W => W, Drange => Rng))); end Create_Discrete_Type; @@ -75,6 +113,7 @@ package body Synth.Values is function Alloc is new Areapools.Alloc_On_Pool_Addr (Float_Type_Type); begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float, + W => 64, Frange => Rng))); end Create_Float_Type; @@ -85,6 +124,7 @@ package body Synth.Values is function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type); begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Vector, + W => Bnd.Len, Vbound => Bnd, Vec_El => El_Type))); end Create_Vector_Type; @@ -92,7 +132,7 @@ package body Synth.Values is function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) return Type_Acc is - W : constant Width := Uns32 (Mutils.Clog2 (Uns64 (Len))); + W : constant Width := Uns32 (Clog2 (Uns64 (Len))); begin return Create_Vector_Type ((Dir => Iir_Downto, Wlen => W, @@ -135,8 +175,14 @@ package body Synth.Values is is subtype Array_Type_Type is Type_Type (Type_Array); function Alloc is new Areapools.Alloc_On_Pool_Addr (Array_Type_Type); + W : Width; begin + W := El_Type.W; + for I in Bnd.D'Range loop + W := W * Bnd.D (I).Len; + end loop; return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Array, + W => W, Abounds => Bnd, Arr_El => El_Type))); end Create_Array_Type; @@ -147,6 +193,7 @@ package body Synth.Values is 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_El => El_Type))); end Create_Unbounded_Array; @@ -198,7 +245,7 @@ package body Synth.Values is function Alloc is new Areapools.Alloc_On_Pool_Addr (Record_Type_Type); begin return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Record, - Rec_W => W, + W => W, Rec => Els))); end Create_Record_Type; @@ -441,28 +488,8 @@ package body Synth.Values is function Get_Type_Width (Atype : Type_Acc) return Width is begin - case Atype.Kind is - when Type_Bit => - return 1; - when Type_Discrete => - 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 Type_Record => - return Atype.Rec_W; - when others => - raise Internal_Error; - end case; + pragma Assert (Atype.Kind /= Type_Unbounded_Array); + return Atype.W; end Get_Type_Width; procedure Init is diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index a0db0f5fb..fa6f0908f 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -32,12 +32,14 @@ package Synth.Values is -- Netlist representation: signed or unsigned, width of vector. Is_Signed : Boolean; - W : Width; Left : Int64; Right : Int64; end record; + -- Return the width of RNG. + function Discrete_Range_Width (Rng : Discrete_Range_Type) return Width; + type Float_Range_Type is record Dir : Iir_Direction; Left : Fp64; @@ -95,6 +97,7 @@ package Synth.Values is type Rec_El_Array_Acc is access Rec_El_Array; type Type_Type (Kind : Type_Kind) is record + W : Width; case Kind is when Type_Bit => null; @@ -111,7 +114,6 @@ package Synth.Values is when Type_Unbounded_Array => Uarr_El : Type_Acc; when Type_Record => - Rec_W : Width; Rec : Rec_El_Array_Acc; end case; end record; @@ -210,7 +212,8 @@ package Synth.Values is Instance_Pool : Areapool_Acc; -- Types. - function Create_Discrete_Type (Rng : Discrete_Range_Type) return Type_Acc; + function Create_Discrete_Type (Rng : Discrete_Range_Type; W : Width) + return Type_Acc; function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc; function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) return Type_Acc; -- cgit v1.2.3