diff options
author | Tristan Gingold <tgingold@free.fr> | 2019-07-27 11:38:19 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2019-07-28 20:27:57 +0200 |
commit | b2ce3ad7385a6d3c3ddb4017f1418b60c83042c4 (patch) | |
tree | 584ce3fa3295d14dcacab94bab7f7ae0e22f49ce /src | |
parent | fc5ed4cb9c73414eeb821aa5183954cee1866251 (diff) | |
download | ghdl-b2ce3ad7385a6d3c3ddb4017f1418b60c83042c4.tar.gz ghdl-b2ce3ad7385a6d3c3ddb4017f1418b60c83042c4.tar.bz2 ghdl-b2ce3ad7385a6d3c3ddb4017f1418b60c83042c4.zip |
synth: preliminary support of dynamic indexing.
Diffstat (limited to 'src')
-rw-r--r-- | src/synth/synth-context.adb | 85 | ||||
-rw-r--r-- | src/synth/synth-context.ads | 5 | ||||
-rw-r--r-- | src/synth/synth-decls.adb | 198 | ||||
-rw-r--r-- | src/synth/synth-expr.adb | 645 | ||||
-rw-r--r-- | src/synth/synth-expr.ads | 20 | ||||
-rw-r--r-- | src/synth/synth-insts.adb | 14 | ||||
-rw-r--r-- | src/synth/synth-stmts.adb | 75 | ||||
-rw-r--r-- | src/synth/synth-stmts.ads | 4 | ||||
-rw-r--r-- | src/synth/synth-values.adb | 284 | ||||
-rw-r--r-- | src/synth/synth-values.ads | 195 | ||||
-rw-r--r-- | src/synth/synthesis.adb | 54 | ||||
-rw-r--r-- | src/vhdl/vhdl-annotations.adb | 111 | ||||
-rw-r--r-- | src/vhdl/vhdl-annotations.ads | 6 |
13 files changed, 956 insertions, 740 deletions
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 67ed96f3f..f89a708b1 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -23,8 +23,6 @@ with Ada.Unchecked_Deallocation; with Types; use Types; with Tables; with Vhdl.Errors; use Vhdl.Errors; -with Vhdl.Std_Package; -with Vhdl.Ieee.Std_Logic_1164; with Netlists.Builders; use Netlists.Builders; with Synth.Types; use Synth.Types; @@ -69,7 +67,7 @@ package body Synth.Context is return Create_Value_Instance (Packages_Table.Last); end Create_Value_Instance; - function Alloc_Wire (Kind : Wire_Kind; Obj : Iir; Bnd : Value_Bound_Acc) + function Alloc_Wire (Kind : Wire_Kind; Obj : Iir; Wtype : Type_Acc) return Value_Acc is Wire : Wire_Id; @@ -79,7 +77,7 @@ package body Synth.Context is else Wire := Alloc_Wire (Kind, Obj); end if; - return Create_Value_Wire (Wire, Bnd); + return Create_Value_Wire (Wire, Wtype); end Alloc_Wire; function Alloc_Object (Kind : Wire_Kind; @@ -88,33 +86,20 @@ package body Synth.Context is return Value_Acc is Obj_Type : constant Iir := Get_Type (Obj); + Otype : Type_Acc; begin case Get_Kind (Obj_Type) is when Iir_Kind_Enumeration_Type_Definition | Iir_Kind_Enumeration_Subtype_Definition => - declare - Info : constant Sim_Info_Acc := - Get_Info (Get_Base_Type (Obj_Type)); - Rng : Value_Bound_Acc; - begin - if Is_Bit_Type (Obj_Type) then - Rng := null; - else - Rng := Create_Value_Bound - ((Dir => Iir_Downto, - Left => Int32 (Info.Width - 1), - Right => 0, - Len => Info.Width)); - end if; - return Alloc_Wire (Kind, Obj, Rng); - end; + Otype := Get_Value_Type (Syn_Inst, Get_Type (Obj)); + return Alloc_Wire (Kind, Obj, Otype); when Iir_Kind_Array_Subtype_Definition => declare - Bounds : Value_Bound_Acc; + Bnd : Value_Acc; begin - Bounds := Synth_Array_Bounds (Syn_Inst, Obj_Type, 0); + Bnd := Get_Value (Syn_Inst, Obj_Type); if Is_Vector_Type (Obj_Type) then - return Alloc_Wire (Kind, Obj, Bounds); + return Alloc_Wire (Kind, Obj, Bnd.Typ); else raise Internal_Error; end if; @@ -122,14 +107,9 @@ package body Synth.Context is when Iir_Kind_Integer_Subtype_Definition => declare Rng : Value_Acc; - Bnd : Value_Bound_Acc; begin Rng := Get_Value (Syn_Inst, Obj_Type); - Bnd := Create_Value_Bound ((Dir => Iir_Downto, - Left => Int32 (Rng.Rng.W - 1), - Right => 0, - Len => Rng.Rng.W)); - return Alloc_Wire (Kind, Obj, Bnd); + return Alloc_Wire (Kind, Obj, Rng.Typ); end; when others => Error_Kind ("alloc_object", Obj_Type); @@ -245,7 +225,16 @@ package body Synth.Context is return Obj_Inst.Objects (Info.Slot); end Get_Value; - function Get_Net (Val : Value_Acc; Vtype : Node) return Net is + function Get_Value_Type (Syn_Inst : Synth_Instance_Acc; Atype : Iir) + return Type_Acc + is + Val : Value_Acc; + begin + Val := Get_Value (Syn_Inst, Atype); + return Val.Typ; + end Get_Value_Type; + + function Get_Net (Val : Value_Acc) return Net is begin case Val.Kind is when Value_Wire => @@ -254,60 +243,44 @@ package body Synth.Context is return Val.N; when Value_Mux2 => declare - Cond : constant Net := - Get_Net (Val.M_Cond, - Vhdl.Std_Package.Boolean_Type_Definition); + Cond : constant Net := Get_Net (Val.M_Cond); begin return Build_Mux2 (Ctxt => Build_Context, Sel => Cond, - I0 => Get_Net (Val.M_F, Vtype), - I1 => Get_Net (Val.M_T, Vtype)); + I0 => Get_Net (Val.M_F), + I1 => Get_Net (Val.M_T)); end; when Value_Discrete => declare - Btype : constant Node := Get_Base_Type (Vtype); Va : Uns32; Zx : Uns32; begin - if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then + 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 Btype = Vhdl.Std_Package.Boolean_Type_Definition - or else Btype = Vhdl.Std_Package.Bit_Type_Definition - then + elsif Val.Typ = Boolean_Type then From_Bit (Val.Scal, Va); return Build_Const_UB32 (Build_Context, Va, 1); - elsif Get_Kind (Btype) = Iir_Kind_Enumeration_Type_Definition - then - return Build_Const_UB32 (Build_Context, Uns32 (Val.Scal), - Get_Info (Btype).Width); else - if Val.Scal >= 0 then - -- FIXME: check width. - return Build_Const_UB32 - (Build_Context, Uns32 (Val.Scal), 32); - else - -- Need Sconst32/Sconst64 - raise Internal_Error; - end if; + return Build_Const_UB32 + (Build_Context, Uns32 (Val.Scal), Val.Typ.Drange.W); end if; end; when Value_Array => - if Val.Bounds.D (1).Len <= 32 then + if Val.Typ.Vbound.Len <= 32 then declare Len : constant Iir_Index32 := - Iir_Index32 (Val.Bounds.D (1).Len); - Etype : constant Node := Get_Element_Subtype (Vtype); + 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, Etype, V, Zx); + 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; diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads index 874962260..2f9c93ee0 100644 --- a/src/synth/synth-context.ads +++ b/src/synth/synth-context.ads @@ -89,10 +89,13 @@ package Synth.Context is -- Get the value of OBJ. function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Iir) return Value_Acc; + -- Wrapper around Get_Value for types. + function Get_Value_Type (Syn_Inst : Synth_Instance_Acc; Atype : Iir) + return Type_Acc; -- Get a net from a scalar/vector value. This will automatically create -- a net for literals. - function Get_Net (Val : Value_Acc; Vtype : Node) return Net; + function Get_Net (Val : Value_Acc) return Net; function Create_Value_Instance (Inst : Synth_Instance_Acc) return Value_Acc; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index 48952ef5a..f1f41c32a 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -24,7 +24,8 @@ with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; -with Synth.Types; use Synth.Types; +with Vhdl.Ieee.Std_Logic_1164; +with Vhdl.Std_Package; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; with Synth.Expr; use Synth.Expr; @@ -46,10 +47,10 @@ package body Synth.Decls is case Val.Kind is when Value_Wire => -- FIXME: get the width directly from the wire ? - W := Get_Bound_Width (Val.W_Bound); + W := Get_Type_Width (Val.Typ); Name := New_Sname (Syn_Inst.Name, Get_Identifier (Decl)); if Init /= null then - Ival := Get_Net (Init, Get_Type (Decl)); + Ival := Get_Net (Init); pragma Assert (Get_Width (Ival) = W); Value := Build_Isignal (Build_Context, Name, Ival); else @@ -64,25 +65,34 @@ package body Synth.Decls is procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node) is + Typ : Type_Acc; begin case Get_Kind (Def) is when Iir_Kind_Enumeration_Type_Definition => - declare - Info : constant Sim_Info_Acc := Get_Info (Def); - Enum_List : constant Node_Flist := - Get_Enumeration_Literal_List (Def); - begin - if Is_Bit_Type (Def) then - Info.Width := 1; - else - Info.Width := - Uns32 (Clog2 (Uns64 (Get_Nbr_Elements (Enum_List)))); - end if; - end; - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Floating_Type_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Array_Type_Definition => + if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type + or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type + then + Typ := Logic_Type; + elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then + Typ := Boolean_Type; + elsif Def = Vhdl.Std_Package.Bit_Type_Definition then + Typ := Bit_Type; + else + declare + Nbr_El : constant Natural := + Get_Nbr_Elements (Get_Enumeration_Literal_List (Def)); + Rng : Discrete_Range_Type; + begin + 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); + end; + end if; + Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); + when Iir_Kind_Array_Type_Definition => null; when Iir_Kind_Access_Type_Definition | Iir_Kind_File_Type_Definition => @@ -103,17 +113,66 @@ package body Synth.Decls is end case; end Synth_Type_Definition; - function Synth_Range_Constraint - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Value_Acc is + procedure Synth_Anonymous_Type_Definition + (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node) + is + Typ : Type_Acc; + begin + case Get_Kind (Def) is + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Physical_Type_Definition => + declare + Cst : constant Node := Get_Range_Constraint (St); + L, R : Int64; + Rng : Discrete_Range_Type; + 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); + Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); + end; + when Iir_Kind_Floating_Type_Definition => + declare + Cst : constant Node := Get_Range_Constraint (St); + L, R : Fp64; + Rng : Float_Range_Type; + begin + L := Get_Fp_Value (Get_Left_Limit (Cst)); + R := Get_Fp_Value (Get_Right_Limit (Cst)); + Rng := (Get_Direction (Cst), L, R); + Typ := Create_Float_Type (Rng); + Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); + end; + when others => + Error_Kind ("synth_anonymous_type_definition", Def); + end case; + end Synth_Anonymous_Type_Definition; + + function Synth_Discrete_Range_Constraint + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type is begin case Get_Kind (Rng) is when Iir_Kind_Range_Expression => -- FIXME: check range. - return Synth_Range_Expression (Syn_Inst, Rng); + return Synth_Discrete_Range_Expression (Syn_Inst, Rng); when others => - Error_Kind ("synth_range_constraint", Rng); + Error_Kind ("synth_discrete_range_constraint", Rng); end case; - end Synth_Range_Constraint; + end Synth_Discrete_Range_Constraint; + + function Synth_Float_Range_Constraint + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type is + begin + case Get_Kind (Rng) is + when Iir_Kind_Range_Expression => + -- FIXME: check range. + return Synth_Float_Range_Expression (Syn_Inst, Rng); + when others => + Error_Kind ("synth_float_range_constraint", Rng); + end case; + end Synth_Float_Range_Constraint; procedure Synth_Subtype_Indication_If_Anonymous (Syn_Inst : Synth_Instance_Acc; Atype : Node) is @@ -123,48 +182,76 @@ package body Synth.Decls is end if; end Synth_Subtype_Indication_If_Anonymous; + function Synth_Array_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc + is + El_Type : constant Node := Get_Element_Subtype (Atype); + St_Indexes : constant Iir_Flist := Get_Index_Subtype_List (Atype); + St_El : Iir; + Etyp : Type_Acc; + Bnds : Bound_Array_Acc; + begin + -- LRM93 12.3.1.3 + -- 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 + St_El := Get_Index_Type (St_Indexes, 0); + return Create_Vector_Type + (Synth_Bounds_From_Range (Syn_Inst, St_El), Etyp); + else + -- FIXME: partially constrained arrays, subtype in indexes... + Bnds := Create_Bound_Array + (Iir_Index32 (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 (Iir_Index32 (I + 1)) := + Synth_Bounds_From_Range (Syn_Inst, St_El); + end loop; + return Create_Array_Type (Bnds, Etyp); + end if; + end Synth_Array_Subtype_Indication; + procedure Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) is + (Syn_Inst : Synth_Instance_Acc; Atype : Node) + is + Typ : Type_Acc; begin case Get_Kind (Atype) is when Iir_Kind_Array_Subtype_Definition => - -- LRM93 12.3.1.3 - -- 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, Get_Element_Subtype (Atype)); - declare - St_Indexes : constant Iir_Flist := - Get_Index_Subtype_List (Atype); - St_El : Iir; - Bnds : Value_Bound_Array_Acc; - begin - -- FIXME: partially constrained arrays, subtype in indexes... - Bnds := Create_Value_Bound_Array - (Iir_Index32 (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 (Iir_Index32 (I + 1)) := - Synth_Bounds_From_Range (Syn_Inst, St_El); - end loop; - Create_Object (Syn_Inst, Atype, - Create_Value_Bounds (Bnds)); - end; + Typ := Synth_Array_Subtype_Indication (Syn_Inst, Atype); when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Physical_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition => declare - Val : Value_Acc; + Btype : constant Type_Acc := + Get_Value_Type (Syn_Inst, Get_Base_Type (Atype)); + Rng : Discrete_Range_Type; + begin + if Btype.Kind = Type_Bit then + -- A subtype of a bit type is still a bit. + Typ := Btype; + else + Rng := Synth_Discrete_Range_Constraint + (Syn_Inst, Get_Range_Constraint (Atype)); + Typ := Create_Discrete_Type (Rng); + end if; + end; + when Iir_Kind_Floating_Subtype_Definition => + declare + Rng : Float_Range_Type; begin - Val := Synth_Range_Constraint + Rng := Synth_Float_Range_Constraint (Syn_Inst, Get_Range_Constraint (Atype)); - Create_Object (Syn_Inst, Atype, Unshare (Val, Instance_Pool)); + Typ := Create_Float_Type (Rng); end; when others => Error_Kind ("synth_subtype_indication", Atype); end case; + Create_Object (Syn_Inst, Atype, Create_Value_Subtype (Typ)); end Synth_Subtype_Indication; procedure Synth_Anonymous_Subtype_Indication @@ -343,9 +430,12 @@ package body Synth.Decls is null; when Iir_Kind_Attribute_Specification => Synth_Attribute_Specification (Syn_Inst, Decl); - when Iir_Kind_Type_Declaration - | Iir_Kind_Anonymous_Type_Declaration => + when Iir_Kind_Type_Declaration => Synth_Type_Definition (Syn_Inst, Get_Type_Definition (Decl)); + when Iir_Kind_Anonymous_Type_Declaration => + Synth_Anonymous_Type_Definition + (Syn_Inst, Get_Type_Definition (Decl), + Get_Subtype_Definition (Decl)); when Iir_Kind_Subtype_Declaration => Synth_Declaration_Type (Syn_Inst, Decl); when Iir_Kind_Component_Declaration => diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index f16dc1990..1e39efb13 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -69,7 +69,7 @@ package body Synth.Expr is case Val.Kind is when Value_Wire | Value_Net => - return Get_Width (Get_Net (Val, Null_Node)); + return Get_Width (Get_Net (Val)); when others => raise Internal_Error; -- TODO end case; @@ -126,15 +126,11 @@ package body Synth.Expr is end From_Bit; procedure To_Logic - (Enum : Int64; Etype : Node; Val : out Uns32; Zx : out Uns32) - is - Btype : constant Node := Get_Base_Type (Etype); + (Enum : Int64; Etype : Type_Acc; Val : out Uns32; Zx : out Uns32) is begin - if Btype = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then + if Etype = Logic_Type then From_Std_Logic (Enum, Val, Zx); - elsif Btype = Vhdl.Std_Package.Boolean_Type_Definition - or else Btype = Vhdl.Std_Package.Bit_Type_Definition - then + elsif Etype = Boolean_Type then From_Bit (Enum, Val); Zx := 0; else @@ -149,19 +145,38 @@ package body Synth.Expr is 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)); + pragma Assert (Val.Typ.Vbound.Len >= Off); + return Val.Arr.V (Iir_Index32 (Val.Typ.Vbound.Len - Off)); when Value_Net | Value_Wire => - N := Build_Extract_Bit - (Build_Context, Get_Net (Val, Null_Node), Off); + N := Build_Extract_Bit (Build_Context, Get_Net (Val), Off); Set_Location (N, Loc); - return Create_Value_Net (N, No_Bound); + return Create_Value_Net (N, Val.Typ.Vec_El); when others => raise Internal_Error; 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); @@ -185,13 +200,11 @@ package body Synth.Expr is return Build_Const_UB32 (Build_Context, Uns32 (Val.Scal), W); end if; - return Synth_Uresize (Get_Net (Val, Vtype), W); + return Synth_Uresize (Get_Net (Val), W); end Synth_Uresize; - function Get_Index_Offset (Index: Value_Acc; - Bounds: Value_Bound_Acc; - Expr: Iir) - return Uns32 is + function Get_Index_Offset + (Index : Value_Acc; Bounds : Bound_Type; Expr : Iir) return Uns32 is begin if Index.Kind = Value_Discrete then declare @@ -223,7 +236,7 @@ package body Synth.Expr is Res : Value_Acc; Dim : Natural) is - Bound : constant Value_Bound_Acc := Res.Bounds.D (1); + Bound : constant Bound_Type := Res.Typ.Abounds.D (1); Aggr_Type : constant Node := Get_Type (Aggr); El_Type : constant Node := Get_Element_Subtype (Aggr_Type); Nbr_Dims : constant Natural := Get_Nbr_Dimensions (Aggr_Type); @@ -276,7 +289,7 @@ package body Synth.Expr is Idx : Value_Acc; begin Idx := Synth_Expression_With_Type - (Syn_Inst, Ch, Idx_Type); + (Syn_Inst, Ch, Get_Base_Type (Idx_Type)); if not Is_Const (Idx) then Error_Msg_Synth (+Ch, "choice is not static"); else @@ -286,11 +299,13 @@ package body Synth.Expr is when Iir_Kind_Choice_By_Range => declare Ch : constant Node := Get_Choice_Range (Assoc); - Rng : Value_Acc; + Rng : Discrete_Range_Type; Val : Value_Acc; begin - Rng := Synth_Range_Expression (Syn_Inst, Ch); - Val := Create_Value_Discrete (Rng.Rng.Left); + Rng := Synth_Discrete_Range_Expression (Syn_Inst, Ch); + Val := Create_Value_Discrete + (Rng.Left, + Get_Value_Type (Syn_Inst, Get_Type (Ch))); while In_Range (Rng, Val.Scal) loop Set_Elem (Get_Index_Offset (Val, Bound, Ch)); Update_Index (Rng, Val.Scal); @@ -377,14 +392,14 @@ package body Synth.Expr is and then Is_Const (Val.Arr.V (Idx)) and then Is_Bit_Type (Etype) loop - To_Logic (Val.Arr.V (Idx).Scal, Etype, B_Va, B_Zx); + To_Logic (Val.Arr.V (Idx).Scal, Val.Typ.Arr_El, B_Va, B_Zx); W_Zx := W_Zx or Shift_Left (B_Zx, Off); W_Va := W_Va or Shift_Left (B_Va, Off); Off := Off + 1; Idx := Idx - 1; end loop; if Off = 0 then - E := Get_Net (Val.Arr.V (Idx), Etype); + E := Get_Net (Val.Arr.V (Idx)); Idx := Idx - 1; else if W_Zx = 0 then @@ -401,100 +416,108 @@ package body Synth.Expr is end loop; Concat_Array (Arr (1 .. Len)); - Res := Create_Value_Net (Arr (1), Val.Bounds.D (1)); + Res := Create_Value_Net (Arr (1), Val.Typ); Free_Net_Array (Arr); return Res; end Vectorize_Array; - function Synth_Range_Expression - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Value_Acc + function Synth_Discrete_Range_Expression + (L : Int64; R : Int64; Dir : Iir_Direction) return Discrete_Range_Type + is + V : Discrete_Range_Type; + Lo, Hi : Int64; + 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))); + 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; + end Synth_Discrete_Range_Expression; + + function Synth_Discrete_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type is L, R : Value_Acc; - Res : Value_Acc; begin L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng)); - case Get_Kind (Get_Type (Rng)) is - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Enumeration_Type_Definition - | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Physical_Type_Definition - | Iir_Kind_Physical_Subtype_Definition => - if not (Is_Const (L) and Is_Const (R)) then - Error_Msg_Synth (+Rng, "limits of range are not constant"); - return null; - end if; - declare - V : Value_Range_Type; - Lo, Hi : Int64; - begin - V.Dir := Get_Direction (Rng); - V.Left := L.Scal; - V.Right := R.Scal; - - 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))); - 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; - Res := Create_Value_Range (V); - end; - when Iir_Kind_Floating_Type_Definition - | Iir_Kind_Floating_Subtype_Definition => - Res := Create_Value_Fp_Range ((Get_Direction (Rng), L.Fp, R.Fp)); - when others => - Error_Kind ("synth_range_expression", Get_Type (Rng)); - end case; - return Res; - end Synth_Range_Expression; - function Synth_Range (Syn_Inst : Synth_Instance_Acc; Bound : Node) - return Value_Acc is + if not (Is_Const (L) and Is_Const (R)) then + Error_Msg_Synth (+Rng, "limits of range are not constant"); + raise Internal_Error; + end if; + + return Synth_Discrete_Range_Expression + (L.Scal, R.Scal, Get_Direction (Rng)); + end Synth_Discrete_Range_Expression; + + function Synth_Float_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type + is + L, R : Value_Acc; + begin + L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); + R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng)); + return ((Get_Direction (Rng), L.Fp, R.Fp)); + end Synth_Float_Range_Expression; + + function Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; Bound : Node) + return Discrete_Range_Type is begin case Get_Kind (Bound) is when Iir_Kind_Range_Expression => - return Synth_Range_Expression (Syn_Inst, Bound); + return Synth_Discrete_Range_Expression (Syn_Inst, Bound); when Iir_Kind_Integer_Subtype_Definition => - return Synth_Range (Syn_Inst, Get_Range_Constraint (Bound)); + 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; + else + return Synth_Discrete_Range + (Syn_Inst, Get_Range_Constraint (Bound)); + end if; when others => - Error_Kind ("synth_range", Bound); + Error_Kind ("synth_discrete_range", Bound); end case; - end Synth_Range; + end Synth_Discrete_Range; function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; Atype : Node; - Dim : Natural) return Value_Bound_Acc + Dim : Natural) return Bound_Type is Info : constant Sim_Info_Acc := Get_Info (Atype); begin @@ -509,30 +532,30 @@ package body Synth.Expr is declare Bnds : constant Value_Acc := Get_Value (Syn_Inst, Atype); begin - return Bnds.Bnds.D (Iir_Index32 (Dim) + 1); + return Bnds.Typ.Vbound; end; end if; end Synth_Array_Bounds; function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; - Atype : Node) return Value_Bound_Acc + Atype : Node) return Bound_Type is - Rng : Value_Acc; + Rng : Discrete_Range_Type; Len : Int64; begin - Rng := Synth_Range (Syn_Inst, Atype); - case Rng.Rng.Dir is + Rng := Synth_Discrete_Range (Syn_Inst, Atype); + case Rng.Dir is when Iir_To => - Len := Rng.Rng.Right - Rng.Rng.Left + 1; + Len := Rng.Right - Rng.Left + 1; when Iir_Downto => - Len := Rng.Rng.Left - Rng.Rng.Right + 1; + Len := Rng.Left - Rng.Right + 1; end case; if Len < 0 then Len := 0; end if; - return Create_Value_Bound - ((Rng.Rng.Dir, Int32 (Rng.Rng.Left), Int32 (Rng.Rng.Right), - Uns32 (Len))); + return (Dir => Rng.Dir, W => Width (Clog2 (Uns64 (Len))), + Left => Int32 (Rng.Left), Right => Int32 (Rng.Right), + Len => Uns32 (Len)); end Synth_Bounds_From_Range; function Synth_Aggregate_Array (Syn_Inst : Synth_Instance_Acc; @@ -540,17 +563,20 @@ package body Synth.Expr is Aggr_Type : Node) return Value_Acc is Ndims : constant Natural := Get_Nbr_Dimensions (Aggr_Type); - Bnds : Value_Bound_Array_Acc; + El_Type : constant Node := Get_Element_Subtype (Aggr_Type); + Bnds : Bound_Array_Acc; + Res_Type : Type_Acc; Res : Value_Acc; begin -- Allocate the result. - Bnds := Create_Value_Bound_Array (Iir_Index32 (Ndims)); + Bnds := Create_Bound_Array (Iir_Index32 (Ndims)); for I in 1 .. Ndims loop Bnds.D (Iir_Index32 (I)) := Synth_Array_Bounds (Syn_Inst, Aggr_Type, I - 1); end loop; - Res := Create_Value_Array (Bnds); - Create_Array_Data (Res); + Res_Type := Create_Array_Type + (Bnds, Get_Value (Syn_Inst, El_Type).Typ); + Res := Create_Value_Array (Res_Type); Fill_Array_Aggregate (Syn_Inst, Aggr, Res, 0); @@ -579,84 +605,74 @@ package body Synth.Expr is end case; end Synth_Aggregate; - function Synth_Bit_Eq_Const - (Cst : Value_Acc; Expr : Value_Acc; Etype : Node; Loc : Node) - return Value_Acc + function Synth_Bit_Eq_Const (Cst : Value_Acc; Expr : Value_Acc; Loc : Node) + return Value_Acc is Val : Uns32; Zx : Uns32; N : Net; begin - To_Logic (Cst.Scal, Etype, Val, Zx); + To_Logic (Cst.Scal, Cst.Typ, Val, Zx); if Zx /= 0 then N := Build_Const_UL32 (Build_Context, 0, 1, 1); Set_Location (N, Loc); - return Create_Value_Net (N, No_Bound); + return Create_Value_Net (N, Boolean_Type); elsif Val = 1 then return Expr; else pragma Assert (Val = 0); - N := Build_Monadic (Build_Context, Id_Not, Get_Net (Expr, Etype)); + N := Build_Monadic (Build_Context, Id_Not, Get_Net (Expr)); Set_Location (N, Loc); - return Create_Value_Net (N, No_Bound); + return Create_Value_Net (N, Boolean_Type); end if; end Synth_Bit_Eq_Const; -- Create the result range of an operator. According to the ieee standard, -- the range is LEN-1 downto 0. - function Create_Res_Bound (Prev : Value_Acc; N : Net) return Value_Bound_Acc + function Create_Res_Bound (Prev : Value_Acc; N : Net) return Type_Acc is - Res : Value_Bound_Acc; + Res : Type_Acc; Wd : Width; begin - case Prev.Kind is - when Value_Net - | Value_Wire => - Res := Extract_Bound (Prev); - when others => - raise Internal_Error; - end case; + Res := Prev.Typ; - if Res /= No_Bound - and then Res.Dir = Iir_Downto - and then Res.Right = 0 + if Res.Vbound.Dir = Iir_Downto + and then Res.Vbound.Right = 0 then -- Normalized range return Res; end if; Wd := Get_Width (N); - return Create_Value_Bound ((Dir => Iir_Downto, - Left => Int32 (Wd - 1), - Right => 0, - Len => Wd)); + return Create_Vec_Type_By_Length (Wd, Res.Vec_El); end Create_Res_Bound; function Create_Bounds_From_Length (Syn_Inst : Synth_Instance_Acc; Atype : Iir; Len : Iir_Index32) - return Value_Bound_Acc + return Bound_Type is - Res : Value_Bound_Acc; - Index_Bounds : Value_Acc; + Res : Bound_Type; + Index_Bounds : Discrete_Range_Type; begin - Index_Bounds := Synth_Range (Syn_Inst, Atype); + Index_Bounds := Synth_Discrete_Range (Syn_Inst, Atype); - Res := Create_Value_Bound ((Left => Int32 (Index_Bounds.Rng.Left), - Right => 0, - Dir => Index_Bounds.Rng.Dir, - Len => Uns32 (Len))); + Res := (Left => Int32 (Index_Bounds.Left), + Right => 0, + Dir => Index_Bounds.Dir, + W => Width (Len), + Len => Uns32 (Len)); if Len = 0 then -- Special case. Res.Right := Res.Left; - case Index_Bounds.Rng.Dir is + case Index_Bounds.Dir is when Iir_To => Res.Left := Res.Right + 1; when Iir_Downto => Res.Left := Res.Right - 1; end case; else - case Index_Bounds.Rng.Dir is + case Index_Bounds.Dir is when Iir_To => Res.Right := Res.Left + Int32 (Len - 1); when Iir_Downto => @@ -682,9 +698,9 @@ package body Synth.Expr is N : Net; begin N := Build_Dyadic (Build_Context, Id, - Get_Net (Left, Ltype), Get_Net (Right, Rtype)); + Get_Net (Left), Get_Net (Right)); Set_Location (N, Expr); - return Create_Value_Net (N, No_Bound); + return Create_Value_Net (N, Left.Typ); end Synth_Bit_Dyadic; function Synth_Compare (Id : Compare_Module_Id) return Value_Acc @@ -692,9 +708,9 @@ package body Synth.Expr is N : Net; begin N := Build_Compare (Build_Context, Id, - Get_Net (Left, Ltype), Get_Net (Right, Rtype)); + Get_Net (Left), Get_Net (Right)); Set_Location (N, Expr); - return Create_Value_Net (N, No_Bound); + return Create_Value_Net (N, Boolean_Type); end Synth_Compare; function Synth_Compare_Uns_Nat (Id : Compare_Module_Id) @@ -704,17 +720,17 @@ package body Synth.Expr is begin N := Synth_Uresize (Right, Rtype, Get_Width (Left)); Set_Location (N, Expr); - N := Build_Compare (Build_Context, Id, Get_Net (Left, Ltype), N); + N := Build_Compare (Build_Context, Id, Get_Net (Left), N); Set_Location (N, Expr); - return Create_Value_Net (N, No_Bound); + return Create_Value_Net (N, Boolean_Type); end Synth_Compare_Uns_Nat; function Synth_Vec_Dyadic (Id : Dyadic_Module_Id) return Value_Acc is - L : constant Net := Get_Net (Left, Ltype); + L : constant Net := Get_Net (Left); N : Net; begin - N := Build_Dyadic (Build_Context, Id, L, Get_Net (Right, Rtype)); + N := Build_Dyadic (Build_Context, Id, L, Get_Net (Right)); Set_Location (N, Expr); return Create_Value_Net (N, Create_Res_Bound (Left, L)); end Synth_Vec_Dyadic; @@ -722,17 +738,17 @@ package body Synth.Expr is function Synth_Dyadic_Uns (Id : Dyadic_Module_Id; Is_Res_Vec : Boolean) return Value_Acc is - L : constant Net := Get_Net (Left, Ltype); - R : constant Net := Get_Net (Right, Rtype); + L : constant Net := Get_Net (Left); + R : constant Net := Get_Net (Right); W : constant Width := Width'Max (Get_Width (L), Get_Width (R)); - Rtype : Value_Bound_Acc; + Rtype : Type_Acc; L1, R1 : Net; N : Net; begin if Is_Res_Vec then - Rtype := Create_Value_Bound ((Iir_Downto, Int32 (W - 1), 0, W)); + Rtype := Create_Vec_Type_By_Length (W, Left.Typ.Vec_El); else - Rtype := No_Bound; + Rtype := Left.Typ; end if; L1 := Synth_Uresize (L, W); Set_Location (L1, Expr); @@ -746,8 +762,8 @@ package body Synth.Expr is function Synth_Compare_Uns_Uns (Id : Compare_Module_Id) return Value_Acc is - L : constant Net := Get_Net (Left, Ltype); - R : constant Net := Get_Net (Right, Rtype); + L : constant Net := Get_Net (Left); + R : constant Net := Get_Net (Right); W : constant Width := Width'Max (Get_Width (L), Get_Width (R)); L1, R1 : Net; N : Net; @@ -758,12 +774,12 @@ package body Synth.Expr is Set_Location (R1, Expr); N := Build_Compare (Build_Context, Id, L1, R1); Set_Location (N, Expr); - return Create_Value_Net (N, No_Bound); + return Create_Value_Net (N, Boolean_Type); end Synth_Compare_Uns_Uns; function Synth_Dyadic_Uns_Nat (Id : Dyadic_Module_Id) return Value_Acc is - L : constant Net := Get_Net (Left, Ltype); + L : constant Net := Get_Net (Left); R1 : Net; N : Net; begin @@ -813,9 +829,9 @@ package body Synth.Expr is if Is_Bit_Type (Ltype) then pragma Assert (Is_Bit_Type (Rtype)); if Is_Const (Left) then - return Synth_Bit_Eq_Const (Left, Right, Ltype, Expr); + return Synth_Bit_Eq_Const (Left, Right, Expr); elsif Is_Const (Right) then - return Synth_Bit_Eq_Const (Right, Left, Ltype, Expr); + return Synth_Bit_Eq_Const (Right, Left, Expr); end if; end if; return Synth_Compare (Id_Eq); @@ -878,7 +894,7 @@ package body Synth.Expr is -- "<" (Unsigned, Natural) if Is_Const (Right) and then Right.Scal = 0 then -- Always false. - return Create_Value_Discrete (0); + return Create_Value_Discrete (0, Boolean_Type); end if; return Synth_Compare_Uns_Nat (Id_Ult); when Iir_Predefined_Ieee_Numeric_Std_Lt_Uns_Uns @@ -902,88 +918,104 @@ package body Synth.Expr is return Synth_Compare_Uns_Uns (Id_Uge); when Iir_Predefined_Array_Element_Concat => declare - L : constant Net := Get_Net (Left, Ltype); + L : constant Net := Get_Net (Left); + Bnd : Bound_Type; N : Net; begin - N := Build_Concat2 (Build_Context, L, Get_Net (Right, Rtype)); + N := Build_Concat2 (Build_Context, L, Get_Net (Right)); Set_Location (N, Expr); + Bnd := Create_Bounds_From_Length + (Syn_Inst, + Get_Index_Type (Get_Type (Expr), 0), + Iir_Index32 (Get_Width (L) + 1)); + return Create_Value_Net - (N, - Create_Bounds_From_Length - (Syn_Inst, - Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Width (L) + 1))); + (N, Create_Vector_Type (Bnd, Right.Typ)); end; when Iir_Predefined_Element_Array_Concat => declare - R : constant Net := Get_Net (Right, Rtype); + R : constant Net := Get_Net (Right); + Bnd : Bound_Type; N : Net; begin - N := Build_Concat2 (Build_Context, Get_Net (Left, Ltype), R); + N := Build_Concat2 (Build_Context, Get_Net (Left), R); Set_Location (N, Expr); + Bnd := Create_Bounds_From_Length + (Syn_Inst, + Get_Index_Type (Get_Type (Expr), 0), + Iir_Index32 (Get_Width (R) + 1)); + return Create_Value_Net - (N, - Create_Bounds_From_Length - (Syn_Inst, - Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Width (R) + 1))); + (N, Create_Vector_Type (Bnd, Left.Typ)); end; when Iir_Predefined_Element_Element_Concat => declare N : Net; + Bnd : Bound_Type; begin - N := Build_Concat2 (Build_Context, - Get_Net (Left, Ltype), - Get_Net (Right, Rtype)); + N := Build_Concat2 + (Build_Context, Get_Net (Left), Get_Net (Right)); Set_Location (N, Expr); + Bnd := Create_Bounds_From_Length + (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2); return Create_Value_Net - (N, - Create_Bounds_From_Length - (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), 2)); + (N, Create_Vector_Type (Bnd, Left.Typ)); end; when Iir_Predefined_Array_Array_Concat => declare - L : constant Net := Get_Net (Left, Ltype); - R : constant Net := Get_Net (Right, Ltype); + L : constant Net := Get_Net (Left); + R : constant Net := Get_Net (Right); + Bnd : Bound_Type; N : Net; begin N := Build_Concat2 (Build_Context, L, R); Set_Location (N, Expr); + Bnd := Create_Bounds_From_Length + (Syn_Inst, + Get_Index_Type (Get_Type (Expr), 0), + Iir_Index32 (Get_Width (L) + Get_Width (R))); + return Create_Value_Net - (N, - Create_Bounds_From_Length - (Syn_Inst, - Get_Index_Type (Get_Type (Expr), 0), - Iir_Index32 (Get_Width (L) + Get_Width (R)))); + (N, Create_Vector_Type (Bnd, Left.Typ.Vec_El)); end; when Iir_Predefined_Integer_Plus => if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete (Left.Scal + Right.Scal); + return Create_Value_Discrete + (Left.Scal + Right.Scal, + Get_Value_Type (Syn_Inst, Get_Type (Expr))); else return Synth_Vec_Dyadic (Id_Add); end if; when Iir_Predefined_Integer_Minus => if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete (Left.Scal - Right.Scal); + return Create_Value_Discrete + (Left.Scal - Right.Scal, + Get_Value_Type (Syn_Inst, Get_Type (Expr))); else return Synth_Vec_Dyadic (Id_Sub); end if; when Iir_Predefined_Integer_Mul => if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete (Left.Scal * Right.Scal); + return Create_Value_Discrete + (Left.Scal * Right.Scal, + Get_Value_Type (Syn_Inst, Get_Type (Expr))); else return Synth_Vec_Dyadic (Id_Mul); end if; when Iir_Predefined_Integer_Div => if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete (Left.Scal / Right.Scal); + return Create_Value_Discrete + (Left.Scal / Right.Scal, + Get_Value_Type (Syn_Inst, Get_Type (Expr))); else Error_Msg_Synth (+Expr, "non-constant division not supported"); return null; end if; when Iir_Predefined_Integer_Mod => if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete (Left.Scal mod Right.Scal); + return Create_Value_Discrete + (Left.Scal mod Right.Scal, + Get_Value_Type (Syn_Inst, Get_Type (Expr))); else Error_Msg_Synth (+Expr, "non-constant mod not supported"); return null; @@ -991,14 +1023,14 @@ package body Synth.Expr is when Iir_Predefined_Integer_Less_Equal => if Is_Const (Left) and then Is_Const (Right) then return Create_Value_Discrete - (Boolean'Pos (Left.Scal <= Right.Scal)); + (Boolean'Pos (Left.Scal <= Right.Scal), Boolean_Type); else return Synth_Compare (Id_Sle); end if; when Iir_Predefined_Integer_Equality => if Is_Const (Left) and then Is_Const (Right) then return Create_Value_Discrete - (Boolean'Pos (Left.Scal = Right.Scal)); + (Boolean'Pos (Left.Scal = Right.Scal), Boolean_Type); else return Synth_Compare (Id_Eq); end if; @@ -1020,14 +1052,13 @@ package body Synth.Expr is function Synth_Bit_Monadic (Id : Monadic_Module_Id) return Value_Acc is begin return Create_Value_Net - (Build_Monadic (Build_Context, Id, - Get_Net (Operand, Get_Type (Operand_Expr))), - No_Bound); + (Build_Monadic (Build_Context, Id, Get_Net (Operand)), + Operand.Typ); end Synth_Bit_Monadic; function Synth_Vec_Monadic (Id : Monadic_Module_Id) return Value_Acc is - Op: constant Net := Get_Net (Operand, Get_Type (Operand_Expr)); + Op: constant Net := Get_Net (Operand); begin return Create_Value_Net (Build_Monadic (Build_Context, Id, Op), @@ -1068,13 +1099,15 @@ package body Synth.Expr is | Iir_Kind_Iterator_Declaration => return Get_Value (Syn_Inst, Name); when Iir_Kind_Enumeration_Literal => - return Create_Value_Discrete (Int64 (Get_Enum_Pos (Name))); + return Create_Value_Discrete + (Int64 (Get_Enum_Pos (Name)), + Get_Value_Type (Syn_Inst, Get_Type (Name))); when others => Error_Kind ("synth_name", Name); end case; end Synth_Name; - function In_Bounds (Bnd : Value_Bound_Acc; V : Int32) return Boolean is + function In_Bounds (Bnd : Bound_Type; V : Int32) return Boolean is begin case Bnd.Dir is when Iir_To => @@ -1087,45 +1120,79 @@ package body Synth.Expr is function Index_To_Offset (Pfx : Value_Acc; Idx : Int64; Loc : Node) return Uns32 is - Rng : Value_Bound_Acc; + Rng : Type_Acc; begin Rng := Extract_Bound (Pfx); - if not In_Bounds (Rng, Int32 (Idx)) then + if not In_Bounds (Rng.Vbound, Int32 (Idx)) then Error_Msg_Synth (+Loc, "index not within bounds"); return 0; end if; -- The offset is from the LSB (bit 0). Bit 0 is the rightmost one. - case Rng.Dir is + case Rng.Vbound.Dir is when Iir_To => - return Uns32 (Rng.Right - Int32 (Idx)); + return Uns32 (Rng.Vbound.Right - Int32 (Idx)); when Iir_Downto => - return Uns32 (Int32 (Idx) - Rng.Right); + return Uns32 (Int32 (Idx) - Rng.Vbound.Right); end case; end Index_To_Offset; + function Dyn_Index_To_Offset (Pfx : Value_Acc; Idx : Net; Loc : Node) + return Net + is + Bnd : Type_Acc; + Off : Net; + Right : Net; + begin + Bnd := Extract_Bound (Pfx); + + -- TODO: handle width. + Right := Build_Const_UB32 + (Build_Context, To_Uns32 (Bnd.Vbound.Right), 32); + Set_Location (Right, Loc); + case Bnd.Vbound.Dir is + when Iir_To => + -- L <= I <= R --> off = R - I + Off := Build_Dyadic (Build_Context, Id_Sub, Right, Idx); + when Iir_Downto => + -- L >= I >= R --> off = I - R + Off := Build_Dyadic (Build_Context, Id_Sub, Idx, Right); + end case; + Set_Location (Off, Loc); + return Off; + end Dyn_Index_To_Offset; + function Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Value_Acc is - Pfx : constant Value_Acc := - Synth_Expression (Syn_Inst, Get_Prefix (Name)); + 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_Val : constant Value_Acc := Synth_Expression (Syn_Inst, Get_Nth_Element (Indexes, 0)); - Off : Uns32; begin if Get_Nbr_Elements (Indexes) /= 1 then Error_Msg_Synth (+Name, "multi-dim arrays not supported"); return null; end if; - if Idx_Val.Kind /= Value_Discrete then - Error_Msg_Synth (+Name, "non constant integer index not supported"); - return null; + 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 + Idx : Net; + Off : Net; + begin + Idx := Get_Net (Idx_Val); + Off := Dyn_Index_To_Offset (Pfx_Val, Idx, Name); + return Dyn_Bit_Extract (Pfx_Val, Off, Name); + end; end if; - - Off := Index_To_Offset (Pfx, Idx_Val.Scal, Name); - return Bit_Extract (Pfx, Off, Name); end Synth_Indexed_Name; function Is_Const (N : Net) return Boolean is @@ -1232,8 +1299,10 @@ package body Synth.Expr is return False; end Is_Same; + -- 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 : Value_Bound_Acc; + Pfx_Bnd : Type_Acc; Left : Net; Right : Net; Inp : out Net; @@ -1277,20 +1346,20 @@ package body Synth.Expr is -- FIXME: what to do with negative values. Step := Uns32 (L_Fac); - case Pfx_Bnd.Dir is + case Pfx_Bnd.Vbound.Dir is when Iir_To => - Off := L_Add - Pfx_Bnd.Left; + Off := L_Add - Pfx_Bnd.Vbound.Left; Width := Uns32 (R_Add - L_Add + 1); when Iir_Downto => - Off := R_Add - Pfx_Bnd.Right; + Off := R_Add - Pfx_Bnd.Vbound.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 : Value_Bound_Acc; - Res_Bnd : out Value_Bound_Acc; + Pfx_Bnd : Type_Acc; + Res_Bnd : out Type_Acc; Inp : out Net; Step : out Uns32; Off : out Int32; @@ -1312,7 +1381,7 @@ package body Synth.Expr is Error_Msg_Synth (+Expr, "only range supported for slices"); end case; - if Pfx_Bnd.Dir /= Dir then + if Pfx_Bnd.Vbound.Dir /= Dir then Error_Msg_Synth (+Name, "direction mismatch in slice"); Step := 0; Wd := 0; @@ -1333,8 +1402,8 @@ package body Synth.Expr is Inp := No_Net; Step := 0; - if not In_Bounds (Pfx_Bnd, Int32 (Left.Scal)) - or else not In_Bounds (Pfx_Bnd, Int32 (Right.Scal)) + if not In_Bounds (Pfx_Bnd.Vbound, Int32 (Left.Scal)) + or else not In_Bounds (Pfx_Bnd.Vbound, Int32 (Right.Scal)) then Error_Msg_Synth (+Name, "index not within bounds"); Wd := 0; @@ -1342,23 +1411,27 @@ package body Synth.Expr is return; end if; - case Pfx_Bnd.Dir is + case Pfx_Bnd.Vbound.Dir is when Iir_To => Wd := Width (Right.Scal - Left.Scal + 1); - Res_Bnd := Create_Value_Bound - (Value_Bound_Type'(Dir => Iir_To, - Len => Wd, - Left => Int32 (Left.Scal), - Right => Int32 (Right.Scal))); - Off := Pfx_Bnd.Right - Res_Bnd.Right; + 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; when Iir_Downto => Wd := Width (Left.Scal - Right.Scal + 1); - Res_Bnd := Create_Value_Bound - (Value_Bound_Type'(Dir => Iir_Downto, - Len => Wd, - Left => Int32 (Left.Scal), - Right => Int32 (Right.Scal))); - Off := Res_Bnd.Right - Pfx_Bnd.Right; + 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; end case; end if; end Synth_Slice_Suffix; @@ -1368,8 +1441,8 @@ package body Synth.Expr is is Pfx_Node : constant Node := Get_Prefix (Name); Pfx : constant Value_Acc := Synth_Expression (Syn_Inst, Pfx_Node); - Bnd : Value_Bound_Acc; - Res_Bnd : Value_Bound_Acc; + Bnd : Type_Acc; + Res_Bnd : Type_Acc; Inp : Net; Step : Uns32; Off : Int32; @@ -1379,15 +1452,12 @@ package body Synth.Expr is Bnd := Extract_Bound (Pfx); Synth_Slice_Suffix (Syn_Inst, Name, Bnd, Res_Bnd, Inp, Step, Off, Wd); if Inp /= No_Net then - N := Build_Dyn_Extract (Build_Context, - Get_Net (Pfx, Get_Type (Pfx_Node)), + N := Build_Dyn_Extract (Build_Context, Get_Net (Pfx), Inp, Step, Off, Wd); Set_Location (N, Name); return Create_Value_Net (N, null); else - N := Build_Extract (Build_Context, - Get_Net (Pfx, Get_Type (Pfx_Node)), - Uns32 (Off), Wd); + N := Build_Extract (Build_Context, Get_Net (Pfx), Uns32 (Off), Wd); Set_Location (N, Name); return Create_Value_Net (N, Res_Bnd); end if; @@ -1427,7 +1497,7 @@ package body Synth.Expr is Lit : Node; Posedge : Boolean; begin - Clk := Get_Net (Synth_Name (Syn_Inst, Prefix), Get_Type (Prefix)); + Clk := Get_Net (Synth_Name (Syn_Inst, Prefix)); if Get_Kind (Expr) /= Iir_Kind_Equality_Operator then Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected"); return Build_Edge (Build_Context, Clk); @@ -1483,14 +1553,14 @@ package body Synth.Expr is Prefix := Extract_Event_Expr_Prefix (Left); if Is_Valid (Prefix) then return Create_Value_Net - (Extract_Clock_Level (Syn_Inst, Right, Prefix), No_Bound); + (Extract_Clock_Level (Syn_Inst, Right, Prefix), Boolean_Type); end if; -- Try with right. Prefix := Extract_Event_Expr_Prefix (Right); if Is_Valid (Prefix) then return Create_Value_Net - (Extract_Clock_Level (Syn_Inst, Left, Prefix), No_Bound); + (Extract_Clock_Level (Syn_Inst, Left, Prefix), Boolean_Type); end if; return null; @@ -1507,14 +1577,16 @@ package body Synth.Expr is case Get_Kind (Conv_Type) is when Iir_Kind_Integer_Subtype_Definition => if Is_Float (Val) then - return Create_Value_Discrete (Int64 (Val.Fp)); + return Create_Value_Discrete + (Int64 (Val.Fp), Get_Value_Type (Syn_Inst, Conv_Type)); else Error_Msg_Synth (+Conv, "unhandled type conversion (to int)"); return null; end if; when Iir_Kind_Floating_Subtype_Definition => if Is_Const (Val) then - return Create_Value_Float (Fp64 (Val.Scal)); + return Create_Value_Float + (Fp64 (Val.Scal), Get_Value_Type (Syn_Inst, Conv_Type)); else Error_Msg_Synth (+Conv, "unhandled type conversion (to float)"); return null; @@ -1565,41 +1637,41 @@ package body Synth.Expr is Id : constant String8_Id := Get_String8_Id (Str); Str_Type : constant Node := Get_Type (Str); - Bounds : Value_Bound_Acc; - Barr : Value_Bound_Array_Acc; + El_Type : Type_Acc; + Bounds : Bound_Type; + Res_Type : Type_Acc; Res : Value_Acc; Pos : Nat8; begin Bounds := Synth_Array_Bounds (Syn_Inst, Str_Type, 0); - Barr := Create_Value_Bound_Array (1); - Barr.D (1) := Bounds; - Res := Create_Value_Array (Barr); + El_Type := Get_Value_Type (Syn_Inst, Get_Element_Subtype (Str_Type)); + Res_Type := Create_Vector_Type (Bounds, El_Type); + Res := Create_Value_Array (Res_Type); for I in Res.Arr.V'Range loop -- FIXME: use literal from type ?? Pos := Str_Table.Element_String8 (Id, Pos32 (I)); - Res.Arr.V (I) := Create_Value_Discrete (Int64 (Pos)); + Res.Arr.V (I) := Create_Value_Discrete (Int64 (Pos), El_Type); end loop; return Res; end Synth_String_Literal; - function Eval_To_Unsigned (Arg : Int64; Sz : Int64) return Value_Acc + function Eval_To_Unsigned (Arg : Int64; Sz : Int64; Res_Type : Type_Acc) + return Value_Acc is Len : constant Iir_Index32 := Iir_Index32 (Sz); Arr : Value_Array_Acc; - Bnds : Value_Bound_Array_Acc; + Bnd : Type_Acc; begin Arr := Create_Value_Array (Len); for I in 1 .. Len loop Arr.V (Len - I + 1) := Create_Value_Discrete - (Std_Logic_0_Pos + (Arg / 2 ** Natural (I - 1)) mod 2); + (Std_Logic_0_Pos + (Arg / 2 ** Natural (I - 1)) mod 2, + Res_Type.Vec_El); end loop; - Bnds := Create_Value_Bound_Array (1); - Bnds.D (1) := Create_Value_Bound - ((Dir => Iir_Downto, Left => Int32 (Len - 1), Right => 0, - Len => Uns32 (Len))); - return Create_Value_Array (Bnds, Arr); + Bnd := Create_Vec_Type_By_Length (Width (Len), Res_Type.Vec_El); + return Create_Value_Array (Bnd, Arr); end Eval_To_Unsigned; function Synth_User_Function_Call @@ -1687,9 +1759,11 @@ package body Synth.Expr is else -- FIXME: what if the arg is constant too ? if Is_Const (Arg) then - return Eval_To_Unsigned (Arg.Scal, Size.Scal); + return Eval_To_Unsigned + (Arg.Scal, Size.Scal, + Get_Value_Type (Syn_Inst, Get_Type (Imp))); else - Arg_Net := Get_Net (Arg, Get_Type (Inter_Chain)); + Arg_Net := Get_Net (Arg); return Create_Value_Net (Synth_Uresize (Arg_Net, Uns32 (Size.Scal)), Create_Res_Bound (Arg, Arg_Net)); @@ -1699,8 +1773,7 @@ package body Synth.Expr is when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat => -- UNSIGNED to Natural. return Create_Value_Net - (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1), - Get_Type (Inter_Chain)), 32), + (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)), 32), null); when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat => declare @@ -1714,8 +1787,8 @@ package body Synth.Expr is end if; W := Uns32 (Sz.Scal); return Create_Value_Net - (Synth_Uresize (Get_Net (V, Get_Type (Inter_Chain)), W), - Create_Value_Bound ((Iir_Downto, Int32 (W) - 1, 0, W))); + (Synth_Uresize (Get_Net (V), W), + Create_Vec_Type_By_Length (W, Logic_Type)); end; when Iir_Predefined_Ieee_Math_Real_Log2 => declare @@ -1729,7 +1802,8 @@ package body Synth.Expr is (+Expr, "argument must be a float value"); return null; end if; - return Create_Value_Float (Log2 (V.Fp)); + return Create_Value_Float + (Log2 (V.Fp), Get_Value_Type (Syn_Inst, Get_Type (Imp))); end; when Iir_Predefined_Ieee_Math_Real_Ceil => declare @@ -1743,7 +1817,8 @@ package body Synth.Expr is (+Expr, "argument must be a float value"); return null; end if; - return Create_Value_Float (Ceil (V.Fp)); + return Create_Value_Float + (Ceil (V.Fp), Get_Value_Type (Syn_Inst, Get_Type (Imp))); end; when others => Error_Msg_Synth @@ -1817,11 +1892,15 @@ package body Synth.Expr is return Synth_Expression_With_Type (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); when Iir_Kind_Integer_Literal => - return Create_Value_Discrete (Get_Value (Expr)); + return Create_Value_Discrete + (Get_Value (Expr), Get_Value_Type (Syn_Inst, Expr_Type)); when Iir_Kind_Floating_Point_Literal => - return Create_Value_Float (Get_Fp_Value (Expr)); + return Create_Value_Float + (Get_Fp_Value (Expr), Get_Value_Type (Syn_Inst, Expr_Type)); when Iir_Kind_Physical_Int_Literal => - return Create_Value_Discrete (Get_Physical_Value (Expr)); + return Create_Value_Discrete + (Get_Physical_Value (Expr), + Get_Value_Type (Syn_Inst, Expr_Type)); when Iir_Kind_String_Literal8 => return Synth_String_Literal (Syn_Inst, Expr); when Iir_Kind_Enumeration_Literal => @@ -1840,18 +1919,16 @@ package body Synth.Expr is if Imp = Vhdl.Ieee.Std_Logic_1164.Rising_Edge then Clk := Get_Net (Synth_Assoc_In - (Syn_Inst, Get_Parameter_Association_Chain (Expr)), - Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type); + (Syn_Inst, Get_Parameter_Association_Chain (Expr))); Edge := Build_Edge (Build_Context, Clk); - return Create_Value_Net (Edge, No_Bound); + return Create_Value_Net (Edge, Boolean_Type); elsif Imp = Vhdl.Ieee.Std_Logic_1164.Falling_Edge then Clk := Get_Net (Synth_Assoc_In - (Syn_Inst, Get_Parameter_Association_Chain (Expr)), - Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type); + (Syn_Inst, Get_Parameter_Association_Chain (Expr))); Clk := Build_Monadic (Build_Context, Id_Not, Clk); Edge := Build_Edge (Build_Context, Clk); - return Create_Value_Net (Edge, No_Bound); + return Create_Value_Net (Edge, Boolean_Type); elsif Get_Implicit_Definition (Imp) /= Iir_Predefined_None then return Synth_Predefined_Function_Call (Syn_Inst, Expr); else diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index ec2c1c956..f2ec51476 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -32,10 +32,10 @@ package Synth.Expr is procedure Set_Location (N : Net; Loc : Node); pragma Inline (Set_Location); - procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32); + procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32); procedure From_Bit (Enum : Int64; Val : out Uns32); procedure To_Logic - (Enum : Int64; Etype : Node; Val : out Uns32; Zx : out Uns32); + (Enum : Int64; Etype : Type_Acc; Val : out Uns32; Zx : out Uns32); function Bit_Extract (Val : Value_Acc; Off : Uns32; Loc : Node) return Value_Acc; @@ -55,14 +55,18 @@ package Synth.Expr is return Value_Acc; function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; - Atype : Node) return Value_Bound_Acc; + Atype : Node) return Bound_Type; function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; Atype : Node; - Dim : Natural) return Value_Bound_Acc; + Dim : Natural) return Bound_Type; - function Synth_Range_Expression - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Value_Acc; + function Synth_Discrete_Range_Expression + (L : Int64; R : Int64; Dir : Iir_Direction) return Discrete_Range_Type; + function Synth_Discrete_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type; + function Synth_Float_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type; -- Convert index IDX in PFX to an offset. LOC is used in case of error. function Index_To_Offset (Pfx : Value_Acc; Idx : Int64; Loc : Node) @@ -70,8 +74,8 @@ package Synth.Expr is procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; Name : Node; - Pfx_Bnd : Value_Bound_Acc; - Res_Bnd : out Value_Bound_Acc; + Pfx_Bnd : Type_Acc; + Res_Bnd : out Type_Acc; Inp : out Net; Step : out Uns32; Off : out Int32; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 0bc361d5c..c9cbd1ea7 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -74,7 +74,7 @@ package body Synth.Insts is when Value_Wire => Idx := Idx + 1; Ports (Idx) := (Name => Name, - W => Get_Bound_Width (Val.W_Bound), + W => Get_Type_Width (Val.Typ), Dir => Dir); when others => raise Internal_Error; -- TODO @@ -297,8 +297,7 @@ package body Synth.Insts is Connect (Get_Input (Inst, Nbr_Inputs), Get_Net (Synth_Expression_With_Type - (Syn_Inst, Actual, Get_Type (Assoc_Inter)), - Get_Type (Assoc_Inter))); + (Syn_Inst, Actual, Get_Type (Assoc_Inter)))); Nbr_Inputs := Nbr_Inputs + 1; when Port_Out | Port_Inout => @@ -422,11 +421,7 @@ package body Synth.Insts is when Value_Wire => -- Create a gate for the output, so that it could be read. Val.W := Alloc_Wire (Wire_Output, Inter); - if Val.W_Bound = null then - W := 1; - else - W := Val.W_Bound.Len; - end if; + W := Get_Type_Width (Val.Typ); Value := Builders.Build_Signal (Build_Context, New_Sname (No_Sname, Get_Identifier (Inter)), W); Set_Wire_Gate (Val.W, Value); @@ -677,8 +672,7 @@ package body Synth.Insts is -- Create a gate for the output, so that it could be read. Val.W := Alloc_Wire (Wire_Output, Inter); W := Get_Output_Desc (Get_Module (Self_Inst), Idx).W; - pragma Assert ((W = 1 and then Val.W_Bound = null) - or else (W /= 1 and then W = Val.W_Bound.Len)); + pragma Assert (W = Get_Type_Width (Val.Typ)); Value := Builders.Build_Output (Build_Context, W); Set_Location (Value, Inter); Inp := Get_Input (Self_Inst, Idx); diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 158fd60df..f9494725d 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -69,11 +69,11 @@ package body Synth.Stmts is (Syn_Inst, Get_We_Value (Wf), Targ_Type); end Synth_Waveform; - procedure Synth_Assign (Dest : Value_Acc; Val : Value_Acc; Vtype : Node) is + procedure Synth_Assign (Dest : Value_Acc; Val : Value_Acc) is begin case Dest.Kind is when Value_Wire => - Phi_Assign (Dest.W, Get_Net (Val, Vtype)); + Phi_Assign (Dest.W, Get_Net (Val)); when others => raise Internal_Error; end case; @@ -84,7 +84,7 @@ package body Synth.Stmts is Val : Value_Acc) is Targ_Type : constant Node := Get_Type (Target); - Bnd : Value_Bound_Acc; + Bnd : Bound_Type; Choice : Node; Assoc : Node; Pos : Uns32; @@ -121,8 +121,7 @@ package body Synth.Stmts is | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Anonymous_Signal_Declaration => - Synth_Assign (Get_Value (Syn_Inst, Target), - Val, Get_Type (Target)); + Synth_Assign (Get_Value (Syn_Inst, Target), Val); when Iir_Kind_Aggregate => Synth_Assignment_Aggregate (Syn_Inst, Target, Val); when Iir_Kind_Indexed_Name => @@ -149,21 +148,20 @@ package body Synth.Stmts is -- FIXME: check index. Targ_Net := Get_Last_Assigned_Value (Targ.W); V := Build_Insert (Build_Context, - Targ_Net, - Get_Net (Val, Get_Type (Target)), + Targ_Net, Get_Net (Val), Index_To_Offset (Targ, Idx.Scal, Target)); Set_Location (V, Target); else raise Internal_Error; end if; - Synth_Assign (Targ, Create_Value_Net (V, null), Get_Type (Pfx)); + Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ)); end; when Iir_Kind_Slice_Name => declare Pfx : constant Node := Get_Prefix (Target); Targ : constant Value_Acc := Get_Value (Syn_Inst, Get_Base_Name (Pfx)); - Res_Bnd : Value_Bound_Acc; + Res_Bnd : Type_Acc; Targ_Net : Net; Inp : Net; Step : Uns32; @@ -179,7 +177,7 @@ package body Synth.Stmts is Synth_Slice_Suffix (Syn_Inst, Target, Extract_Bound (Targ), Res_Bnd, Inp, Step, Off, Wd); Targ_Net := Get_Last_Assigned_Value (Targ.W); - V := Get_Net (Val, Get_Type (Target)); + V := Get_Net (Val); if Inp /= No_Net then Res := Build_Dyn_Insert (Build_Context, Targ_Net, V, Inp, Step, Off); @@ -188,8 +186,7 @@ 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), Get_Type (Pfx)); + Synth_Assign (Targ, Create_Value_Net (Res, Res_Bnd)); end; when others => Error_Kind ("synth_assignment", Target); @@ -298,8 +295,7 @@ package body Synth.Stmts is end if; Pop_Phi (Phi_False); - Merge_Phis (Build_Context, Get_Net (Cond_Val, Get_Type (Cond)), - Phi_True, Phi_False); + Merge_Phis (Build_Context, Get_Net (Cond_Val), Phi_True, Phi_False); end if; end Synth_If_Statement; @@ -725,7 +721,7 @@ package body Synth.Stmts is -- Build mux2/mux4 tree (group by 4) Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices); - Sel_Net := Get_Net (Sel, Get_Type (Expr)); + Sel_Net := Get_Net (Sel); -- For each wire, compute the result. for I in Wires'Range loop @@ -833,8 +829,7 @@ package body Synth.Stmts is Alts (Alt_Idx).Val := Get_Net (Synth_Waveform - (Syn_Inst, Get_Associated_Chain (Choice), Targ_Type), - Targ_Type); + (Syn_Inst, Get_Associated_Chain (Choice), Targ_Type)); end if; case Get_Kind (Choice) is @@ -877,7 +872,7 @@ package body Synth.Stmts is -- Build mux2/mux4 tree (group by 4) Case_El := new Case_Element_Array (1 .. Case_Info.Nbr_Choices); - Sel_Net := Get_Net (Sel, Get_Type (Expr)); + Sel_Net := Get_Net (Sel); declare Res : Net; @@ -1033,19 +1028,19 @@ package body Synth.Stmts is Areapools.Release (M, Instance_Pool.all); end Synth_Procedure_Call; - function In_Range (Rng : Value_Acc; V : Int64) return Boolean is + function In_Range (Rng : Discrete_Range_Type; V : Int64) return Boolean is begin - case Rng.Rng.Dir is + case Rng.Dir is when Iir_To => - return V >= Rng.Rng.Left and then V <= Rng.Rng.Right; + return V >= Rng.Left and then V <= Rng.Right; when Iir_Downto => - return V <= Rng.Rng.Left and then V >= Rng.Rng.Right; + return V <= Rng.Left and then V >= Rng.Right; end case; end In_Range; - procedure Update_Index (Rng : Value_Acc; Idx : in out Int64) is + procedure Update_Index (Rng : Discrete_Range_Type; Idx : in out Int64) is begin - case Rng.Rng.Dir is + case Rng.Dir is when Iir_To => Idx := Idx + 1; when Iir_Downto => @@ -1058,23 +1053,22 @@ package body Synth.Stmts is is Iterator : constant Node := Get_Parameter_Specification (Stmt); Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt); - It_Rng : Value_Acc; - It_Type : Node; + It_Type : constant Node := Get_Declaration_Type (Iterator); + It_Rng : Type_Acc; Val : Value_Acc; begin - It_Type := Get_Declaration_Type (Iterator); if It_Type /= Null_Node then Synth_Subtype_Indication (Syn_Inst, It_Type); end if; -- Initial value. - It_Rng := Get_Value (Syn_Inst, Get_Type (Iterator)); - Val := Create_Value_Discrete (It_Rng.Rng.Left); + It_Rng := Get_Value_Type (Syn_Inst, Get_Type (Iterator)); + Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); Create_Object (Syn_Inst, Iterator, Val); - while In_Range (It_Rng, Val.Scal) loop + while In_Range (It_Rng.Drange, Val.Scal) loop Synth_Sequential_Statements (Syn_Inst, Stmts); - Update_Index (It_Rng, Val.Scal); + Update_Index (It_Rng.Drange, Val.Scal); end loop; Destroy_Object (Syn_Inst, Iterator); if It_Type /= Null_Node then @@ -1163,7 +1157,7 @@ package body Synth.Stmts is Push_Phi; Pop_Phi (Phi_False); - Merge_Phis (Build_Context, Get_Net (Cond_Val, Get_Type (Cond)), + Merge_Phis (Build_Context, Get_Net (Cond_Val), Phi_True, Phi_False); end Synth_Process_Sequential_Statements; @@ -1218,7 +1212,7 @@ package body Synth.Stmts is end if; return; end if; - Build_Assert (Build_Context, Get_Net (Val, Get_Type (Cond))); + Build_Assert (Build_Context, Get_Net (Val)); end Synth_Concurrent_Assertion_Statement; function Synth_PSL_Expression @@ -1231,7 +1225,7 @@ package body Synth.Stmts is declare E : constant Vhdl.Types.Vhdl_Node := Get_HDL_Node (Expr); begin - return Get_Net (Synth_Expression (Syn_Inst, E), Get_Type (E)); + return Get_Net (Synth_Expression (Syn_Inst, E)); end; when N_Not_Bool => return Build_Monadic @@ -1365,21 +1359,20 @@ package body Synth.Stmts is Iterator : constant Node := Get_Parameter_Specification (Stmt); Bod : constant Node := Get_Generate_Statement_Body (Stmt); Configs : constant Node := Get_Generate_Block_Configuration (Bod); + It_Type : constant Node := Get_Declaration_Type (Iterator); Config : Node; - It_Rng : Value_Acc; - It_Type : Node; + It_Rng : Type_Acc; Val : Value_Acc; begin - It_Type := Get_Declaration_Type (Iterator); if It_Type /= Null_Node then Synth_Subtype_Indication (Syn_Inst, It_Type); end if; -- Initial value. - It_Rng := Get_Value (Syn_Inst, Get_Type (Iterator)); - Val := Create_Value_Discrete (It_Rng.Rng.Left); + It_Rng := Get_Value_Type (Syn_Inst, Get_Type (Iterator)); + Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); - while In_Range (It_Rng, Val.Scal) loop + while In_Range (It_Rng.Drange, Val.Scal) loop -- Find and apply the config block. declare Spec : Node; @@ -1402,7 +1395,7 @@ package body Synth.Stmts is end; Synth_Generate_Statement_Body (Syn_Inst, Bod, Iterator, Val); - Update_Index (It_Rng, Val.Scal); + Update_Index (It_Rng.Drange, Val.Scal); end loop; end Synth_For_Generate_Statement; diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index 257acfdfd..296e639e4 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -41,7 +41,7 @@ package Synth.Stmts is (Syn_Inst : Synth_Instance_Acc; Stmts : Node); -- For iterators. - function In_Range (Rng : Value_Acc; V : Int64) return Boolean; - procedure Update_Index (Rng : Value_Acc; Idx : in out Int64); + function In_Range (Rng : Discrete_Range_Type; V : Int64) return Boolean; + procedure Update_Index (Rng : Discrete_Range_Type; Idx : in out Int64); end Synth.Stmts; diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 92587fd55..01e460c77 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -22,14 +22,16 @@ with Ada.Unchecked_Conversion; with System; package body Synth.Values is + function To_Bound_Array_Acc is new Ada.Unchecked_Conversion + (System.Address, Bound_Array_Acc); + + function To_Type_Acc is new Ada.Unchecked_Conversion + (System.Address, Type_Acc); + function To_Value_Acc is new Ada.Unchecked_Conversion (System.Address, Value_Acc); function To_Value_Array_Acc is new Ada.Unchecked_Conversion (System.Address, Values.Value_Array_Acc); - function To_Value_Bound_Acc is new Ada.Unchecked_Conversion - (System.Address, Value_Bound_Acc); - function To_Value_Bound_Array_Acc is new Ada.Unchecked_Conversion - (System.Address, Value_Bound_Array_Acc); function Is_Equal (L, R : Value_Acc) return Boolean is begin @@ -40,8 +42,93 @@ package body Synth.Values is raise Internal_Error; end Is_Equal; - function Create_Value_Wire (W : Wire_Id; Bnd : Value_Bound_Acc) - return Value_Acc + 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))); + end Create_Bit_Type; + + function Create_Discrete_Type (Rng : Discrete_Range_Type) 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, + Drange => Rng))); + end Create_Discrete_Type; + + function Create_Float_Type (Rng : Float_Range_Type) return Type_Acc + is + subtype Float_Type_Type is Type_Type (Type_Float); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Float_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Float, + Frange => Rng))); + end Create_Float_Type; + + function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) + return Type_Acc + is + subtype Vector_Type_Type is Type_Type (Type_Vector); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Vector_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Vector, + Vbound => Bnd, + Vec_El => El_Type))); + end Create_Vector_Type; + + function Create_Vec_Type_By_Length (Len : Width; El : Type_Acc) + return Type_Acc is + begin + return Create_Vector_Type ((Dir => Iir_Downto, + W => 0, + Left => Int32 (Len) - 1, + Right => 0, + Len => Len), + El); + end Create_Vec_Type_By_Length; + + function Create_Bound_Array (Ndims : Iir_Index32) return Bound_Array_Acc + is + use System; + subtype Data_Type is Bound_Array (Ndims); + Res : Address; + begin + -- Manually allocate the array to handle large arrays without + -- creating a large temporary value. + Areapools.Allocate + (Current_Pool.all, Res, + Data_Type'Size / Storage_Unit, Data_Type'Alignment); + + declare + -- Discard the warnings for no pragma Import as we really want + -- to use the default initialization. + pragma Warnings (Off); + Addr1 : constant Address := Res; + Init : Data_Type; + for Init'Address use Addr1; + pragma Warnings (On); + begin + null; + end; + + 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 + is + subtype Array_Type_Type is Type_Type (Type_Array); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Array_Type_Type); + begin + return To_Type_Acc (Alloc (Current_Pool, (Kind => Type_Array, + Abounds => Bnd, + Arr_El => El_Type))); + end Create_Array_Type; + + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc is subtype Value_Type_Wire is Value_Type (Values.Value_Wire); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Wire); @@ -49,17 +136,17 @@ package body Synth.Values is return To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Wire, W => W, - W_Bound => Bnd))); + Typ => Wtype))); end Create_Value_Wire; - function Create_Value_Net (N : Net; Bnd : Value_Bound_Acc) return Value_Acc + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Value_Acc is subtype Value_Type_Net is Value_Type (Value_Net); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Net); begin return To_Value_Acc (Alloc (Current_Pool, - Value_Type_Net'(Kind => Value_Net, N => N, N_Bound => Bnd))); + Value_Type_Net'(Kind => Value_Net, N => N, Typ => Ntype))); end Create_Value_Net; function Create_Value_Mux2 (Cond : Value_Acc; T : Value_Acc; F : Value_Acc) @@ -67,28 +154,35 @@ package body Synth.Values is is subtype Value_Type_Mux2 is Value_Type (Value_Mux2); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Mux2); + pragma Assert (T.Typ = F.Typ); begin return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Mux2, M_Cond => Cond, M_T => T, M_F => F))); + (Kind => Value_Mux2, + Typ => T.Typ, + M_Cond => Cond, M_T => T, M_F => F))); end Create_Value_Mux2; - function Create_Value_Discrete (Val : Int64) return Value_Acc + function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) + return Value_Acc is subtype Value_Type_Discrete is Value_Type (Value_Discrete); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Discrete); begin return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Discrete, Scal => Val))); + (Kind => Value_Discrete, Scal => Val, + Typ => Vtype))); end Create_Value_Discrete; - function Create_Value_Float (Val : Fp64) return Value_Acc + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Value_Acc is subtype Value_Type_Float is Value_Type (Value_Float); function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Float); begin return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Float, Fp => Val))); + (Kind => Value_Float, + Typ => Vtype, + Fp => Val))); end Create_Value_Float; function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc @@ -118,8 +212,7 @@ package body Synth.Values is return To_Value_Array_Acc (Res); end Create_Value_Array; - function Create_Value_Array (Bounds : Value_Bound_Array_Acc; - Arr : Value_Array_Acc) + function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Value_Acc is subtype Value_Type_Array is Value_Type (Value_Array); @@ -129,7 +222,7 @@ package body Synth.Values is begin Res := To_Value_Acc (Alloc (Current_Pool, (Kind => Value_Array, - Arr => Arr, Bounds => Bounds))); + Arr => Arr, Typ => Bounds))); return Res; end Create_Value_Array; @@ -138,16 +231,22 @@ package body Synth.Values is Len : Width; begin Len := 1; - for I in Arr.Bounds.D'Range loop - Len := Len * Arr.Bounds.D (I).Len; - end loop; + case Arr.Typ.Kind is + when Type_Array => + for I in Arr.Typ.Abounds.D'Range loop + Len := Len * Arr.Typ.Abounds.D (I).Len; + end loop; + when Type_Vector => + Len := Arr.Typ.Vbound.Len; + when others => + raise Internal_Error; + end case; Arr.Arr := Create_Value_Array (Iir_Index32 (Len)); end Create_Array_Data; - function Create_Value_Array (Bounds : Value_Bound_Array_Acc) - return Value_Acc + function Create_Value_Array (Bounds : Type_Acc) return Value_Acc is Res : Value_Acc; begin @@ -156,48 +255,6 @@ package body Synth.Values is return Res; end Create_Value_Array; - function Create_Value_Bound_Array (Ndim : Iir_Index32) - return Value_Bound_Array_Acc - is - use System; - subtype Data_Type is Value_Bound_Array (Ndim); - Res : Address; - begin - -- Manually allocate the array to handle large arrays without - -- creating a large temporary value. - Areapools.Allocate - (Current_Pool.all, Res, - Data_Type'Size / Storage_Unit, Data_Type'Alignment); - - declare - -- Discard the warnings for no pragma Import as we really want - -- to use the default initialization. - pragma Warnings (Off); - Addr1 : constant Address := Res; - Init : Data_Type; - for Init'Address use Addr1; - pragma Warnings (On); - begin - null; - end; - - return To_Value_Bound_Array_Acc (Res); - end Create_Value_Bound_Array; - - function Create_Value_Bounds (Bounds : Value_Bound_Array_Acc) - return Value_Acc - is - subtype Value_Type_Bounds is Value_Type (Value_Bounds); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Bounds); - - Res : Value_Acc; - begin - Res := To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Bounds, - Bnds => Bounds))); - return Res; - end Create_Value_Bounds; - function Create_Value_Instance (Inst : Instance_Id) return Value_Acc is subtype Value_Type_Instance is Value_Type (Value_Instance); @@ -205,72 +262,25 @@ package body Synth.Values is begin return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Instance, Instance => Inst))); + (Kind => Value_Instance, Instance => Inst, Typ => null))); end Create_Value_Instance; - function Create_Value_Range (Rng : Value_Range_Type) return Value_Acc - is - subtype Value_Type_Range is Value_Type (Value_Range); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Range); - begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Range, Rng => Rng))); - end Create_Value_Range; - - function Create_Value_Fp_Range (Rng : Value_Fp_Range_Type) return Value_Acc + function Create_Value_Subtype (Typ : Type_Acc) return Value_Acc is - subtype Value_Type_Fp_Range is Value_Type (Value_Fp_Range); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Fp_Range); + subtype Value_Type_Subtype is Value_Type (Value_Subtype); + function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Subtype); begin return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Fp_Range, Fp_Rng => Rng))); - end Create_Value_Fp_Range; - - function Create_Value_Bound (Dir : Iir_Direction; Left, Right : Value_Acc) - return Value_Bound_Acc is - begin - pragma Assert (Left.Kind = Right.Kind); - case Left.Kind is - when Value_Discrete => - declare - Len : Int64; - begin - case Dir is - when Iir_To => - Len := Right.Scal - Left.Scal + 1; - when Iir_Downto => - Len := Left.Scal - Right.Scal + 1; - end case; - if Len < 0 then - Len := 0; - end if; - return Create_Value_Bound - ((Dir, Int32 (Left.Scal), Int32 (Right.Scal), - Len => Uns32 (Len))); - end; - when others => - raise Internal_Error; - end case; - end Create_Value_Bound; - - function Create_Value_Bound (Bnd : Value_Bound_Type) return Value_Bound_Acc - is - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Bound_Type); - begin - return To_Value_Bound_Acc (Alloc (Current_Pool, Bnd)); - end Create_Value_Bound; + (Kind => Value_Subtype, Typ => Typ))); + end Create_Value_Subtype; function Copy (Src: in Value_Acc) return Value_Acc is Res: Value_Acc; begin case Src.Kind is - when Value_Range => - Res := Create_Value_Range (Src.Rng); - when Value_Fp_Range => - Res := Create_Value_Fp_Range (Src.Fp_Rng); when Value_Wire => - Res := Create_Value_Wire (Src.W, Src.W_Bound); + Res := Create_Value_Wire (Src.W, Src.Typ); when others => raise Internal_Error; end case; @@ -289,28 +299,30 @@ package body Synth.Values is return Res; end Unshare; - function Extract_Bound (Val : Value_Acc) return Value_Bound_Acc is + function Extract_Bound (Val : Value_Acc) return Type_Acc is begin - case Val.Kind is - when Value_Net => - return Val.N_Bound; - when Value_Wire => - return Val.W_Bound; - when Value_Array => - -- For constants. - pragma Assert (Val.Bounds.Len = 1); - return Val.Bounds.D (1); + return Val.Typ; + end Extract_Bound; + + 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 others => raise Internal_Error; end case; - end Extract_Bound; + end Get_Type_Width; - function Get_Bound_Width (Bnd : Value_Bound_Acc) return Width is + procedure Init is begin - if Bnd = null then - return 1; - else - return Bnd.Len; - end if; - end Get_Bound_Width; + Instance_Pool := Global_Pool'Access; + Boolean_Type := Create_Bit_Type; + Logic_Type := Create_Bit_Type; + Bit_Type := Create_Bit_Type; + end Init; end Synth.Values; diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index 21eeaf0c2..9f93ab0b9 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -26,6 +26,80 @@ with Areapools; use Areapools; package Synth.Values is + type Discrete_Range_Type is record + -- An integer range. + Dir : Iir_Direction; + + -- Netlist representation: signed or unsigned, width of bus. + Is_Signed : Boolean; + W : Width; + + Left : Int64; + Right : Int64; + end record; + + type Float_Range_Type is record + Dir : Iir_Direction; + Left : Fp64; + Right : Fp64; + end record; + + type Bound_Type is record + Dir : Iir_Direction; + W : Width; + Left : Int32; + Right : Int32; + Len : Width; + end record; + + type Bound_Array_Type is array (Iir_Index32 range <>) of Bound_Type; + + type Bound_Array (Len : Iir_Index32) is record + D : Bound_Array_Type (1 .. Len); + end record; + + type Bound_Array_Acc is access Bound_Array; + + type Type_Kind is + ( + Type_Bit, + Type_Discrete, + Type_Float, + Type_Vector, + Type_Array, + Type_Record + ); + + type Type_Type (Kind : Type_Kind); + type Type_Acc is access Type_Type; + + type Type_Acc_Array_Type is array (Iir_Index32 range <>) of Type_Acc; + + type Type_Acc_Array (Len : Iir_Index32) is record + E : Type_Acc_Array_Type (1 .. Len); + end record; + + type Type_Acc_Array_Acc is access Type_Acc_Array; + + type Type_Type (Kind : Type_Kind) is record + case Kind is + when Type_Bit => + null; + when Type_Discrete => + Drange : Discrete_Range_Type; + when Type_Float => + Frange : Float_Range_Type; + when Type_Vector => + Vbound : Bound_Type; + Vec_El : Type_Acc; + when Type_Array => + Abounds : Bound_Array_Acc; + Arr_El : Type_Acc; + when Type_Record => + Rec : Type_Acc_Array_Acc; + end case; + end record; + -- Values is how signals and variables are decomposed. This is similar to -- values in simulation, but simplified (no need to handle files, -- accesses...) @@ -46,23 +120,17 @@ package Synth.Values is Value_Float, - Value_Range, - Value_Fp_Range, - - -- A range with a length. - Value_Bound, - - -- A vector of bounds, for arrays. - Value_Bounds, - - -- A non-vector array. + -- An array. Value_Array, -- A record. Value_Record, -- A package. - Value_Instance + Value_Instance, + + -- A subtype. + Value_Subtype ); type Value_Type (Kind : Value_Kind); @@ -78,54 +146,15 @@ package Synth.Values is type Value_Array_Acc is access Value_Array_Type; - type Value_Range_Type is record - -- An integer range. - Dir : Iir_Direction; - - -- Netlist representation: signed or unsigned, width of bus. - Is_Signed : Boolean; - W : Width; - - Left : Int64; - Right : Int64; - end record; - - type Value_Fp_Range_Type is record - Dir : Iir_Direction; - Left : Fp64; - Right : Fp64; - end record; - - type Value_Bound_Type is record - Dir : Iir_Direction; - Left : Int32; - Right : Int32; - Len : Width; - end record; - - type Value_Bound_Acc is access Value_Bound_Type; - - No_Bound : constant Value_Bound_Acc := null; - - type Value_Bound_Array_Type is array (Iir_Index32 range <>) of - Value_Bound_Acc; - - type Value_Bound_Array (Len : Iir_Index32) is record - D : Value_Bound_Array_Type (1 .. Len); - end record; - - type Value_Bound_Array_Acc is access Value_Bound_Array; - type Instance_Id is new Nat32; type Value_Type (Kind : Value_Kind) is record + Typ : Type_Acc; case Kind is when Value_Net => N : Net; - N_Bound : Value_Bound_Acc; when Value_Wire => W : Wire_Id; - W_Bound : Value_Bound_Acc; when Value_Mux2 => M_Cond : Value_Acc; M_T : Value_Acc; @@ -134,17 +163,10 @@ package Synth.Values is Scal : Int64; when Value_Float => Fp : Fp64; - when Value_Range => - Rng : Value_Range_Type; - when Value_Fp_Range => - Fp_Rng : Value_Fp_Range_Type; - when Value_Bound => - Bnd : Value_Bound_Acc; - when Value_Bounds => - Bnds : Value_Bound_Array_Acc; + when Value_Subtype => + null; when Value_Array => Arr : Value_Array_Acc; - Bounds : Value_Bound_Array_Acc; when Value_Record => Rec : Value_Array_Acc; when Value_Instance => @@ -161,56 +183,61 @@ package Synth.Values is -- Pool for objects allocated in the current instance. Instance_Pool : Areapool_Acc; + -- Types. + function Create_Discrete_Type (Rng : Discrete_Range_Type) 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; + function Create_Vector_Type (Bnd : Bound_Type; El_Type : Type_Acc) + return Type_Acc; + 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 Is_Equal (L, R : Value_Acc) return Boolean; -- Create a Value_Net. - function Create_Value_Net (N : Net; Bnd : Value_Bound_Acc) return Value_Acc; + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Value_Acc; -- Create a Value_Wire. For a bit wire, RNG must be null. - function Create_Value_Wire (W : Wire_Id; Bnd : Value_Bound_Acc) - return Value_Acc; + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc; -- Create a mux2. function Create_Value_Mux2 (Cond : Value_Acc; T : Value_Acc; F : Value_Acc) return Value_Acc; - function Create_Value_Discrete (Val : Int64) return Value_Acc; + function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) + return Value_Acc; - function Create_Value_Float (Val : Fp64) return Value_Acc; + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Value_Acc; + + function Create_Value_Subtype (Typ : Type_Acc) return Value_Acc; function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc; - function Create_Value_Bound_Array (Ndim : Iir_Index32) - return Value_Bound_Array_Acc; -- Create a Value_Array. - function Create_Value_Array (Bounds : Value_Bound_Array_Acc; - Arr : Value_Array_Acc) + function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Value_Acc; -- Like the previous one but automatically build the array. - function Create_Value_Array (Bounds : Value_Bound_Array_Acc) - return Value_Acc; - - function Create_Value_Bounds (Bounds : Value_Bound_Array_Acc) - return Value_Acc; + function Create_Value_Array (Bounds : Type_Acc) return Value_Acc; -- Allocate the ARR component of the Value_Type ARR, using BOUNDS. procedure Create_Array_Data (Arr : Value_Acc); function Create_Value_Instance (Inst : Instance_Id) return Value_Acc; - function Create_Value_Bound (Bnd : Value_Bound_Type) return Value_Bound_Acc; - - -- Allocate a Value_Range. - function Create_Value_Range (Rng : Value_Range_Type) return Value_Acc; - function Create_Value_Fp_Range (Rng : Value_Fp_Range_Type) return Value_Acc; - function Create_Value_Bound (Dir : Iir_Direction; Left, Right : Value_Acc) - return Value_Bound_Acc; - function Unshare (Src : Value_Acc; Pool : Areapool_Acc) return Value_Acc; - function Extract_Bound (Val : Value_Acc) return Value_Bound_Acc; + function Extract_Bound (Val : Value_Acc) return Type_Acc; + + function Get_Type_Width (Atype : Type_Acc) return Width; + + procedure Init; - function Get_Bound_Width (Bnd : Value_Bound_Acc) return Width; + -- Set by Init. + Boolean_Type : Type_Acc := null; + Logic_Type : Type_Acc := null; + Bit_Type : Type_Acc := null; end Synth.Values; diff --git a/src/synth/synthesis.adb b/src/synth/synthesis.adb index 644342d7f..7ebb9602e 100644 --- a/src/synth/synthesis.adb +++ b/src/synth/synthesis.adb @@ -35,8 +35,43 @@ pragma Unreferenced (Synth.Environment.Debug); with Errorout; use Errorout; with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Std_Package; package body Synthesis is + procedure Synth_Convertible_Declarations (Syn_Inst : Synth_Instance_Acc) + is + use Vhdl.Std_Package; + begin + Create_Object + (Syn_Inst, Convertible_Integer_Type_Definition, + Get_Value (Syn_Inst, Universal_Integer_Type_Definition)); + Create_Object + (Syn_Inst, Convertible_Real_Type_Definition, + Get_Value (Syn_Inst, Universal_Real_Type_Definition)); + end Synth_Convertible_Declarations; + + procedure Synth_Package_Declaration + (Parent_Inst : Synth_Instance_Acc; Pkg : Node) + is + use Vhdl.Std_Package; + pragma Assert (not Is_Uninstantiated_Package (Pkg)); + Info : constant Sim_Info_Acc := Get_Info (Pkg); + Syn_Inst : Synth_Instance_Acc; + Val : Value_Acc; + begin + Syn_Inst := Make_Instance (Parent_Inst, Info); + Val := Create_Value_Instance (Syn_Inst); + if Parent_Inst /= Global_Instance then + Create_Object (Parent_Inst, Pkg, Val); + else + Parent_Inst.Objects (Info.Pkg_Slot) := Val; + end if; + Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); + if Pkg = Vhdl.Std_Package.Standard_Package then + Synth_Convertible_Declarations (Syn_Inst); + end if; + end Synth_Package_Declaration; + procedure Synth_Dependencies (Parent_Inst : Synth_Instance_Acc; Unit : Node) is Dep_List : constant Node_List := Get_Dependence_List (Unit); @@ -60,22 +95,7 @@ package body Synthesis is when Iir_Kind_Context_Declaration => null; when Iir_Kind_Package_Declaration => - pragma Assert (not Is_Uninstantiated_Package (Dep_Unit)); - declare - Info : constant Sim_Info_Acc := Get_Info (Dep_Unit); - Syn_Inst : Synth_Instance_Acc; - Val : Value_Acc; - begin - Syn_Inst := Make_Instance (Parent_Inst, Info); - Val := Create_Value_Instance (Syn_Inst); - if Parent_Inst /= Global_Instance then - Create_Object (Parent_Inst, Dep_Unit, Val); - else - Parent_Inst.Objects (Info.Pkg_Slot) := Val; - end if; - Synth_Declarations - (Syn_Inst, Get_Declaration_Chain (Dep_Unit)); - end; + Synth_Package_Declaration (Parent_Inst, Dep_Unit); when Iir_Kind_Package_Instantiation_Declaration => null; when Iir_Kind_Package_Body => @@ -113,7 +133,7 @@ package body Synthesis is Global_Module := New_Design (New_Sname_Artificial (Get_Identifier ("top"))); Build_Context := Build_Builders (Global_Module); - Instance_Pool := Global_Pool'Access; + Synth.Values.Init; Global_Instance := Make_Instance (null, Global_Info); Synth.Insts.Init; diff --git a/src/vhdl/vhdl-annotations.adb b/src/vhdl/vhdl-annotations.adb index af6c3dc64..75382cc5f 100644 --- a/src/vhdl/vhdl-annotations.adb +++ b/src/vhdl/vhdl-annotations.adb @@ -54,6 +54,11 @@ package body Vhdl.Annotations is begin Block_Info.Nbr_Objects := Block_Info.Nbr_Objects + 1; case Obj_Kind is + when Kind_Type => + Info := new Sim_Info_Type'(Kind => Kind_Type, + Ref => Obj, + Obj_Scope => Block_Info, + Slot => Block_Info.Nbr_Objects); when Kind_Object => Info := new Sim_Info_Type'(Kind => Kind_Object, Ref => Obj, @@ -272,41 +277,45 @@ package body Vhdl.Annotations is case Get_Kind (Def) is when Iir_Kind_Enumeration_Type_Definition => - declare - Info : Sim_Info_Acc; - Nbr_Enums : Natural; - begin - if Def = Vhdl.Std_Package.Boolean_Type_Definition - or else Def = Vhdl.Std_Package.Bit_Type_Definition - then - Info := new Sim_Info_Type'(Kind => Kind_Bit_Type, - Ref => Def, - Width => 1); - elsif Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type - or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type - then - Info := new Sim_Info_Type'(Kind => Kind_Log_Type, - Ref => Def, - Width => 1); - else - Nbr_Enums := Get_Nbr_Elements - (Get_Enumeration_Literal_List (Def)); - if Nbr_Enums <= 256 then - Info := new Sim_Info_Type'(Kind => Kind_E8_Type, + if Flag_Synthesis then + Create_Object_Info (Block_Info, Def, Kind_Type); + else + declare + Info : Sim_Info_Acc; + Nbr_Enums : Natural; + begin + if Def = Vhdl.Std_Package.Boolean_Type_Definition + or else Def = Vhdl.Std_Package.Bit_Type_Definition + then + Info := new Sim_Info_Type'(Kind => Kind_Bit_Type, Ref => Def, - Width => 0); - else - Info := new Sim_Info_Type'(Kind => Kind_E32_Type, + Width => 1); + elsif Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type + or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type + then + Info := new Sim_Info_Type'(Kind => Kind_Log_Type, Ref => Def, - Width => 0); + Width => 1); + else + Nbr_Enums := Get_Nbr_Elements + (Get_Enumeration_Literal_List (Def)); + if Nbr_Enums <= 256 then + Info := new Sim_Info_Type'(Kind => Kind_E8_Type, + Ref => Def, + Width => 0); + else + Info := new Sim_Info_Type'(Kind => Kind_E32_Type, + Ref => Def, + Width => 0); + end if; end if; - end if; - Set_Info (Def, Info); - if not Flag_Synthesis then - Annotate_Range_Expression - (Block_Info, Get_Range_Constraint (Def)); - end if; - end; + Set_Info (Def, Info); + if not Flag_Synthesis then + Annotate_Range_Expression + (Block_Info, Get_Range_Constraint (Def)); + end if; + end; + end if; when Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Floating_Subtype_Definition @@ -336,23 +345,35 @@ package body Vhdl.Annotations is end case; end if; if Flag_Synthesis then - Create_Object_Info (Block_Info, Def); + Create_Object_Info (Block_Info, Def, Kind_Type); end if; when Iir_Kind_Integer_Type_Definition => - Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, - Ref => Def, - Width => 0)); + if Flag_Synthesis then + Create_Object_Info (Block_Info, Def, Kind_Type); + else + Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, + Ref => Def, + Width => 0)); + end if; when Iir_Kind_Floating_Type_Definition => - Set_Info (Def, new Sim_Info_Type'(Kind => Kind_F64_Type, - Ref => Def, - Width => 0)); + if Flag_Synthesis then + Create_Object_Info (Block_Info, Def, Kind_Type); + else + Set_Info (Def, new Sim_Info_Type'(Kind => Kind_F64_Type, + Ref => Def, + Width => 0)); + end if; when Iir_Kind_Physical_Type_Definition => - Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, - Ref => Def, - Width => 0)); + if Flag_Synthesis then + Create_Object_Info (Block_Info, Def, Kind_Type); + else + Set_Info (Def, new Sim_Info_Type'(Kind => Kind_I64_Type, + Ref => Def, + Width => 0)); + end if; when Iir_Kind_Array_Type_Definition => El := Get_Element_Subtype (Def); @@ -365,7 +386,7 @@ package body Vhdl.Annotations is end if; if Flag_Synthesis then -- For the bounds. - Create_Object_Info (Block_Info, Def); + Create_Object_Info (Block_Info, Def, Kind_Type); else declare List : constant Iir_Flist := Get_Index_Subtype_List (Def); @@ -1253,7 +1274,7 @@ package body Vhdl.Annotations is Put_Line ("-- nbr objects:" & Object_Slot_Type'Image (Info.Nbr_Objects)); - when Kind_Object | Kind_Signal | Kind_File + when Kind_Type | Kind_Object | Kind_Signal | Kind_File | Kind_Terminal | Kind_Quantity | Kind_PSL => @@ -1290,7 +1311,7 @@ package body Vhdl.Annotations is when others => null; end case; - when Kind_Object | Kind_Signal | Kind_File + when Kind_Type | Kind_Object | Kind_Signal | Kind_File | Kind_Terminal | Kind_Quantity | Kind_PSL => Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot)); diff --git a/src/vhdl/vhdl-annotations.ads b/src/vhdl/vhdl-annotations.ads index 5da4ed175..be39173fe 100644 --- a/src/vhdl/vhdl-annotations.ads +++ b/src/vhdl/vhdl-annotations.ads @@ -42,6 +42,7 @@ package Vhdl.Annotations is Kind_Bit_Type, Kind_Log_Type, Kind_E8_Type, Kind_E32_Type, Kind_I64_Type, Kind_F64_Type, Kind_File_Type, + Kind_Type, Kind_Object, Kind_Signal, Kind_File, Kind_Terminal, Kind_Quantity, @@ -111,7 +112,8 @@ package Vhdl.Annotations is | Kind_File | Kind_Terminal | Kind_Quantity - | Kind_PSL => + | Kind_PSL + | Kind_Type => -- Block in which this object is declared in. Obj_Scope : Sim_Info_Acc; @@ -123,7 +125,7 @@ package Vhdl.Annotations is | Kind_E8_Type | Kind_E32_Type | Kind_I64_Type - | Kind_F64_Type=> + | Kind_F64_Type => Width : Uns32; when Kind_File_Type => |