diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/synth/netlists-builders.adb | 4 | ||||
| -rw-r--r-- | src/synth/synth-decls.adb | 28 | ||||
| -rw-r--r-- | src/synth/synth-decls.ads | 4 | ||||
| -rw-r--r-- | src/synth/synth-expr.adb | 218 | ||||
| -rw-r--r-- | src/synth/synth-expr.ads | 7 | ||||
| -rw-r--r-- | src/synth/synth-insts.adb | 14 | ||||
| -rw-r--r-- | src/synth/synth-oper.adb | 6 | ||||
| -rw-r--r-- | src/synth/synth-stmts.adb | 195 |
8 files changed, 250 insertions, 226 deletions
diff --git a/src/synth/netlists-builders.adb b/src/synth/netlists-builders.adb index 3e0b2ebbc..e35c34b49 100644 --- a/src/synth/netlists-builders.adb +++ b/src/synth/netlists-builders.adb @@ -923,7 +923,9 @@ package body Netlists.Builders is O := Get_Output (Inst, 0); Set_Width (O, Wd); Connect (Get_Input (Inst, 0), I); - Connect (Get_Input (Inst, 1), V); + if V /= No_Net then + Connect (Get_Input (Inst, 1), V); + end if; Connect (Get_Input (Inst, 2), P); Set_Param_Uns32 (Inst, 0, Step); Set_Param_Uns32 (Inst, 1, To_Uns32 (Off)); diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index f41d0e9ca..ecc5d8572 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -28,7 +28,6 @@ with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; with Vhdl.Ieee.Std_Logic_1164; -with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; with Synth.Expr; use Synth.Expr; with Synth.Stmts; @@ -382,7 +381,9 @@ package body Synth.Decls is is Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl); First_Decl : Node; + Decl_Type : Node; Val : Value_Acc; + Obj_Type : Type_Acc; begin if Deferred_Decl = Null_Node or else Get_Deferred_Declaration_Flag (Decl) @@ -401,8 +402,17 @@ package body Synth.Decls is First_Decl := Null_Node; end if; if First_Decl /= Null_Node then + -- Use the type of the declaration. The type of the constant may + -- be derived from the value. + -- FIXME: what about multiple declarations ? + Decl_Type := Get_Subtype_Indication (Decl); + if Get_Kind (Decl_Type) in Iir_Kinds_Denoting_Name then + -- Type mark. + Decl_Type := Get_Type (Get_Named_Entity (Decl_Type)); + end if; + Obj_Type := Get_Value_Type (Syn_Inst, Decl_Type); Val := Synth_Expression_With_Type - (Syn_Inst, Get_Default_Value (Decl), Get_Type (Decl)); + (Syn_Inst, Get_Default_Value (Decl), Obj_Type); Create_Object_Force (Syn_Inst, First_Decl, Val); end if; end Synth_Constant_Declaration; @@ -412,6 +422,7 @@ package body Synth.Decls is is Value : Iir_Attribute_Value; Val : Value_Acc; + Val_Type : Type_Acc; begin Value := Get_Attribute_Value_Spec_Chain (Decl); while Value /= Null_Iir loop @@ -423,8 +434,9 @@ package body Synth.Decls is -- subtype conversion is first performed on the value, -- unless the attribute's subtype indication denotes an -- unconstrained array type. + Val_Type := Get_Value_Type (Syn_Inst, Get_Type (Value)); Val := Synth_Expression_With_Type - (Syn_Inst, Get_Expression (Decl), Get_Type (Value)); + (Syn_Inst, Get_Expression (Decl), Val_Type); -- Check_Constraints (Instance, Val, Attr_Type, Decl); -- 3. A new instance of the designated attribute is created @@ -461,11 +473,12 @@ package body Synth.Decls is Def : constant Iir := Get_Default_Value (Decl); -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; Init : Value_Acc; + Obj_Type : Type_Acc; begin Make_Object (Syn_Inst, Wire_Variable, Decl); if Is_Valid (Def) then - Init := Synth_Expression_With_Type - (Syn_Inst, Def, Get_Type (Decl)); + Obj_Type := Get_Value_Type (Syn_Inst, Get_Type (Decl)); + Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Type); else Init := null; end if; @@ -487,11 +500,12 @@ package body Synth.Decls is Def : constant Iir := Get_Default_Value (Decl); -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; Init : Value_Acc; + Obj_Type : Type_Acc; begin Make_Object (Syn_Inst, Wire_Signal, Decl); if Is_Valid (Def) then - Init := Synth_Expression_With_Type - (Syn_Inst, Def, Get_Type (Decl)); + Obj_Type := Get_Value_Type (Syn_Inst, Get_Type (Decl)); + Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Type); else Init := null; end if; diff --git a/src/synth/synth-decls.ads b/src/synth/synth-decls.ads index dda550ed9..c76fe1d61 100644 --- a/src/synth/synth-decls.ads +++ b/src/synth/synth-decls.ads @@ -20,12 +20,16 @@ with Vhdl.Nodes; use Vhdl.Nodes; with Synth.Context; use Synth.Context; +with Synth.Values; use Synth.Values; package Synth.Decls is -- Get the type of DECL iff it is standalone (not an already existing -- subtype). function Get_Declaration_Type (Decl : Node) return Node; + function Synth_Array_Subtype_Indication + (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc; + procedure Synth_Subtype_Indication (Syn_Inst : Synth_Instance_Acc; Atype : Node); diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 9f32082c2..5e76d3eb4 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -38,6 +38,7 @@ with Netlists.Locations; use Netlists.Locations; with Synth.Types; use Synth.Types; with Synth.Errors; use Synth.Errors; with Synth.Environment; +with Synth.Decls; with Synth.Stmts; use Synth.Stmts; with Synth.Oper; use Synth.Oper; @@ -248,9 +249,8 @@ package body Synth.Expr is is Bound : constant Bound_Type := Get_Array_Bound (Typ, Dim); Aggr_Type : constant Node := Get_Type (Aggr); - El_Type : constant Node := Get_Element_Subtype (Aggr_Type); + El_Typ : constant Type_Acc := Get_Array_Element (Typ); Nbr_Dims : constant Natural := Get_Nbr_Dimensions (Aggr_Type); - Idx_Type : constant Node := Get_Index_Type (Aggr_Type, Dim); type Boolean_Array is array (Uns32 range <>) of Boolean; pragma Pack (Boolean_Array); -- FIXME: test Res.V (I) instead. @@ -264,7 +264,7 @@ package body Synth.Expr is Val : Value_Acc; begin if Dim = Nbr_Dims - 1 then - Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Type); + Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Typ); Res.V (Iir_Index32 (Pos + 1)) := Val; pragma Assert (not Is_Set (Pos)); Is_Set (Pos) := True; @@ -303,8 +303,7 @@ package body Synth.Expr is Ch : constant Node := Get_Choice_Expression (Assoc); Idx : Value_Acc; begin - Idx := Synth_Expression_With_Type - (Syn_Inst, Ch, Get_Base_Type (Idx_Type)); + Idx := Synth_Expression (Syn_Inst, Ch); if not Is_Const (Idx) then Error_Msg_Synth (+Ch, "choice is not static"); else @@ -351,9 +350,11 @@ package body Synth.Expr is procedure Set_Elem (Pos : Natural) is Val : Value_Acc; + El_Type : Type_Acc; begin - Val := Synth_Expression_With_Type - (Syn_Inst, Value, Get_Type (Get_Nth_Element (El_List, Pos))); + El_Type := Get_Value_Type + (Syn_Inst, Get_Type (Get_Nth_Element (El_List, Pos))); + Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Type); Rec.V (Iir_Index32 (Pos + 1)) := Val; if Const_P and not Is_Const (Val) then Const_P := False; @@ -434,66 +435,6 @@ package body Synth.Expr is return Arr (Arr'First); end Concat_Array; - -- Convert the one-dimension VAL to a net by concatenating. - function Vectorize_Array (Val : Value_Acc; Etype : Node) return Value_Acc - is - Arr : Net_Array_Acc; - Len : Int32; - Idx : Iir_Index32; - Res : Value_Acc; - begin - -- Dynamically allocate ARR to handle large arrays. - Arr := new Net_Array (1 .. Int32 (Val.Arr.Len)); - - -- Gather consecutive constant values. - Idx := Val.Arr.Len; - Len := 0; - while Idx > 0 loop - declare - W_Zx, B_Zx : Uns32; - W_Va, B_Va : Uns32; - Off : Natural; - E : Net; - begin - W_Zx := 0; - W_Va := 0; - Off := 0; - while Idx > 0 - and then Off < 32 - and then Is_Const (Val.Arr.V (Idx)) - and then Is_Bit_Type (Etype) - loop - 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)); - Idx := Idx - 1; - else - if W_Zx = 0 then - E := Build_Const_UB32 - (Build_Context, W_Va, Uns32 (Off)); - else - E := Build_Const_UL32 - (Build_Context, W_Va, W_Zx, Uns32 (Off)); - end if; - end if; - Len := Len + 1; - Arr (Len) := E; - end; - end loop; - - Concat_Array (Arr (1 .. Len)); - Res := Create_Value_Net (Arr (1), Val.Typ); - - Free_Net_Array (Arr); - - return Res; - end Vectorize_Array; - function Synth_Discrete_Range_Expression (L : Int64; R : Int64; Dir : Iir_Direction) return Discrete_Range_Type is begin @@ -648,52 +589,21 @@ package body Synth.Expr is function Synth_Aggregate_Array (Syn_Inst : Synth_Instance_Acc; Aggr : Node; - Aggr_Type : Node) return Value_Acc + Aggr_Type : Type_Acc) return Value_Acc is - Ndims : constant Natural := Get_Nbr_Dimensions (Aggr_Type); - El_Type : constant Node := Get_Element_Subtype (Aggr_Type); - El_Typ : Type_Acc; - Res_Type : Type_Acc; Arr : Value_Array_Acc; Res : Value_Acc; Const_P : Boolean; begin - El_Typ := Get_Value_Type (Syn_Inst, El_Type); - - -- Allocate the result. - if Is_Vector_Type (Aggr_Type) then - declare - Bnd : Bound_Type; - begin - Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 0); - Res_Type := Create_Vector_Type (Bnd, El_Typ); - end; - else - declare - Bnds : Bound_Array_Acc; - begin - 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_Type := Create_Array_Type (Bnds, El_Typ); - end; - end if; - Arr := Create_Value_Array - (Iir_Index32 (Get_Array_Flat_Length (Res_Type))); + (Iir_Index32 (Get_Array_Flat_Length (Aggr_Type))); - Fill_Array_Aggregate (Syn_Inst, Aggr, Arr, Res_Type, 0, Const_P); + Fill_Array_Aggregate (Syn_Inst, Aggr, Arr, Aggr_Type, 0, Const_P); if Const_P then - Res := Create_Value_Const_Array (Res_Type, Arr); + Res := Create_Value_Const_Array (Aggr_Type, Arr); else - Res := Create_Value_Array (Res_Type, Arr); - end if; - - if False and Is_Vector_Type (Aggr_Type) then - Res := Vectorize_Array (Res, Get_Element_Subtype (Aggr_Type)); + Res := Create_Value_Array (Aggr_Type, Arr); end if; return Res; @@ -701,23 +611,21 @@ package body Synth.Expr is function Synth_Aggregate_Record (Syn_Inst : Synth_Instance_Acc; Aggr : Node; - Aggr_Type : Node) return Value_Acc + Aggr_Type : Type_Acc) return Value_Acc is - Res_Type : Type_Acc; Arr : Value_Array_Acc; Res : Value_Acc; Const_P : Boolean; begin -- Allocate the result. - Res_Type := Get_Value_Type (Syn_Inst, Aggr_Type); - Arr := Create_Value_Array (Res_Type.Rec.Len); + Arr := Create_Value_Array (Aggr_Type.Rec.Len); Fill_Record_Aggregate (Syn_Inst, Aggr, Arr, Const_P); if Const_P then - Res := Create_Value_Const_Record (Res_Type, Arr); + Res := Create_Value_Const_Record (Aggr_Type, Arr); else - Res := Create_Value_Record (Res_Type, Arr); + Res := Create_Value_Record (Aggr_Type, Arr); end if; return Res; @@ -726,18 +634,23 @@ package body Synth.Expr is -- Aggr_Type is the type from the context. function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc; Aggr : Node; - Aggr_Type : Node) return Value_Acc is + Aggr_Type : Type_Acc) return Value_Acc is begin - case Get_Kind (Aggr_Type) is - when Iir_Kind_Array_Type_Definition => - return Synth_Aggregate_Array (Syn_Inst, Aggr, Get_Type (Aggr)); - when Iir_Kind_Array_Subtype_Definition => + case Aggr_Type.Kind is + when Type_Unbounded_Array | Type_Unbounded_Vector => + declare + Res_Type : Type_Acc; + begin + Res_Type := Decls.Synth_Array_Subtype_Indication + (Syn_Inst, Get_Type (Aggr)); + return Synth_Aggregate_Array (Syn_Inst, Aggr, Res_Type); + end; + when Type_Vector | Type_Array => return Synth_Aggregate_Array (Syn_Inst, Aggr, Aggr_Type); - when Iir_Kind_Record_Type_Definition - | Iir_Kind_Record_Subtype_Definition => + when Type_Record => return Synth_Aggregate_Record (Syn_Inst, Aggr, Aggr_Type); when others => - Error_Kind ("synth_aggregate", Aggr_Type); + raise Internal_Error; end case; end Synth_Aggregate; @@ -772,7 +685,7 @@ package body Synth.Expr is for I in Flist_First .. Last loop Val := Synth_Expression_With_Type - (Syn_Inst, Get_Nth_Element (Els, I), El_Type); + (Syn_Inst, Get_Nth_Element (Els, I), El_Typ); pragma Assert (Is_Const (Val)); Arr.V (Iir_Index32 (Last - I + 1)) := Val; end loop; @@ -863,7 +776,7 @@ package body Synth.Expr is when Type_Vector => pragma Assert (Vtype.Kind = Type_Vector or Vtype.Kind = Type_Slice); - if Dtype.W /= Vtype.W then + if False and then Dtype.W /= Vtype.W then -- TODO: bad width. raise Internal_Error; end if; @@ -983,6 +896,7 @@ package body Synth.Expr is Indexes : constant Iir_Flist := Get_Index_List (Name); Idx_Expr : constant Node := Get_Nth_Element (Indexes, 0); Idx_Val : Value_Acc; + Idx_Type : Type_Acc; begin if Get_Nbr_Elements (Indexes) /= 1 then Error_Msg_Synth (+Name, "multi-dim arrays not yet supported"); @@ -990,8 +904,9 @@ package body Synth.Expr is end if; -- Use the base type as the subtype of the index is not synth-ed. - Idx_Val := Synth_Expression_With_Type - (Syn_Inst, Idx_Expr, Get_Base_Type (Get_Type (Idx_Expr))); + Idx_Type := Get_Value_Type + (Syn_Inst, Get_Base_Type (Get_Type (Idx_Expr))); + Idx_Val := Synth_Expression_With_Type (Syn_Inst, Idx_Expr, Idx_Type); if Pfx_Type.Kind = Type_Vector then W := 1; @@ -1234,8 +1149,10 @@ package body Synth.Expr is case Get_Kind (Expr) is when Iir_Kind_Range_Expression => - Left := Synth_Expression (Syn_Inst, Get_Left_Limit (Expr)); - Right := Synth_Expression (Syn_Inst, Get_Right_Limit (Expr)); + Left := Synth_Expression_With_Basetype + (Syn_Inst, Get_Left_Limit (Expr)); + Right := Synth_Expression_With_Basetype + (Syn_Inst, Get_Right_Limit (Expr)); Dir := Get_Direction (Expr); when others => Error_Msg_Synth (+Expr, "only range supported for slices"); @@ -1521,7 +1438,7 @@ package body Synth.Expr is end Synth_String_Literal; function Synth_Expression_With_Type - (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Node) + (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Type_Acc) return Value_Acc is Res : Value_Acc; @@ -1574,8 +1491,7 @@ package body Synth.Expr is | Iir_Kind_Interface_Signal_Declaration -- For PSL. | Iir_Kind_Signal_Declaration => -- For PSL. Res := Synth_Name (Syn_Inst, Expr); - return Synth_Subtype_Conversion - (Res, Get_Value_Type (Syn_Inst, Expr_Type), False, Expr); + return Synth_Subtype_Conversion (Res, Expr_Type, False, Expr); when Iir_Kind_Reference_Name => return Synth_Name (Syn_Inst, Get_Named_Entity (Expr)); when Iir_Kind_Indexed_Name => @@ -1602,16 +1518,13 @@ 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), Get_Value_Type (Syn_Inst, Expr_Type)); + return Create_Value_Discrete (Get_Value (Expr), Expr_Type); when Iir_Kind_Floating_Point_Literal => - return Create_Value_Float - (Get_Fp_Value (Expr), Get_Value_Type (Syn_Inst, Expr_Type)); + return Create_Value_Float (Get_Fp_Value (Expr), Expr_Type); when Iir_Kind_Physical_Int_Literal | Iir_Kind_Physical_Fp_Literal => return Create_Value_Discrete - (Get_Physical_Value (Expr), - Get_Value_Type (Syn_Inst, Expr_Type)); + (Get_Physical_Value (Expr), Expr_Type); when Iir_Kind_String_Literal8 => return Synth_String_Literal (Syn_Inst, Expr); when Iir_Kind_Enumeration_Literal => @@ -1620,7 +1533,9 @@ package body Synth.Expr is return Synth_Type_Conversion (Syn_Inst, Expr); when Iir_Kind_Qualified_Expression => return Synth_Expression_With_Type - (Syn_Inst, Get_Expression (Expr), Get_Type (Expr)); + (Syn_Inst, Get_Expression (Expr), + Get_Value_Type (Syn_Inst, Get_Type (Get_Named_Entity + (Get_Type_Mark (Expr))))); when Iir_Kind_Function_Call => declare Imp : constant Node := Get_Implementation (Expr); @@ -1652,29 +1567,20 @@ package body Synth.Expr is return Synth_Simple_Aggregate (Syn_Inst, Expr); when Iir_Kind_Left_Array_Attribute => declare - -- Use base type as the expression type is the index subtype. - Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Base_Type (Expr_Type)); B : Bound_Type; begin B := Synth_Array_Attribute (Syn_Inst, Expr); - return Create_Value_Discrete (Int64 (B.Left), Typ); + return Create_Value_Discrete (Int64 (B.Left), Expr_Type); end; when Iir_Kind_Right_Array_Attribute => declare - -- Use base type as the expression type is the index subtype. - Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Base_Type (Expr_Type)); B : Bound_Type; begin B := Synth_Array_Attribute (Syn_Inst, Expr); - return Create_Value_Discrete (Int64 (B.Right), Typ); + return Create_Value_Discrete (Int64 (B.Right), Expr_Type); end; when Iir_Kind_High_Array_Attribute => declare - -- Use base type as the expression type is the index subtype. - Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Base_Type (Expr_Type)); B : Bound_Type; V : Int32; begin @@ -1685,13 +1591,10 @@ package body Synth.Expr is when Iir_Downto => V := B.Left; end case; - return Create_Value_Discrete (Int64 (V), Typ); + return Create_Value_Discrete (Int64 (V), Expr_Type); end; when Iir_Kind_Low_Array_Attribute => declare - -- Use base type as the expression type is the index subtype. - Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Base_Type (Expr_Type)); B : Bound_Type; V : Int32; begin @@ -1702,17 +1605,14 @@ package body Synth.Expr is when Iir_Downto => V := B.Right; end case; - return Create_Value_Discrete (Int64 (V), Typ); + return Create_Value_Discrete (Int64 (V), Expr_Type); end; when Iir_Kind_Length_Array_Attribute => declare - -- Use base type as the expression type is the index subtype. - Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Base_Type (Expr_Type)); B : Bound_Type; begin B := Synth_Array_Attribute (Syn_Inst, Expr); - return Create_Value_Discrete (Int64 (B.Len), Typ); + return Create_Value_Discrete (Int64 (B.Len), Expr_Type); end; when others => Error_Kind ("synth_expression_with_type", Expr); @@ -1722,7 +1622,17 @@ package body Synth.Expr is function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc is begin - return Synth_Expression_With_Type (Syn_Inst, Expr, Get_Type (Expr)); + return Synth_Expression_With_Type + (Syn_Inst, Expr, Get_Value_Type (Syn_Inst, Get_Type (Expr))); end Synth_Expression; + function Synth_Expression_With_Basetype + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc + is + Basetype : Type_Acc; + begin + Basetype := Get_Value_Type (Syn_Inst, Get_Base_Type (Get_Type (Expr))); + return Synth_Expression_With_Type (Syn_Inst, Expr, Basetype); + end Synth_Expression_With_Basetype; + end Synth.Expr; diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 142a8a3a2..dbe092434 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -58,12 +58,17 @@ package Synth.Expr is function Concat_Array (Arr : Net_Array_Acc) return Net; function Synth_Expression_With_Type - (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Node) + (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Type_Acc) return Value_Acc; function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + -- Use base type of EXPR to synthesize EXPR. Useful when the type of + -- EXPR is defined by itself or a range. + function Synth_Expression_With_Basetype + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Bound_Type; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 275efcfeb..11d890c42 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -447,6 +447,7 @@ package body Synth.Insts is Assoc_Inter : Node; Actual : Node; Inter : Node; + Inter_Type : Type_Acc; begin Assoc := Get_Port_Map_Aspect_Chain (Stmt); Assoc_Inter := Get_Port_Chain (Component); @@ -465,10 +466,11 @@ package body Synth.Insts is Synth_Declaration_Type (Comp_Inst, Inter); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => - Create_Object - (Comp_Inst, Assoc_Inter, - Synth_Expression_With_Type - (Syn_Inst, Actual, Get_Type (Assoc_Inter))); + Inter_Type := + Get_Value_Type (Comp_Inst, Get_Type (Assoc_Inter)); + Create_Object (Comp_Inst, Assoc_Inter, + Synth_Expression_With_Type + (Syn_Inst, Actual, Inter_Type)); when Port_Out | Port_Inout => Make_Object (Comp_Inst, Wire_None, Assoc_Inter); @@ -590,9 +592,11 @@ package body Synth.Insts is Synth_Declaration_Type (Syn_Inst, Inter); declare Val : Value_Acc; + Inter_Type : Type_Acc; begin + Inter_Type := Get_Value_Type (Syn_Inst, Get_Type (Inter)); Val := Synth_Expression_With_Type - (Syn_Inst, Get_Default_Value (Inter), Get_Type (Inter)); + (Syn_Inst, Get_Default_Value (Inter), Inter_Type); Create_Object (Syn_Inst, Inter, Val); end; Inter := Get_Chain (Inter); diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb index 2b4da90e3..0f229aea8 100644 --- a/src/synth/synth-oper.adb +++ b/src/synth/synth-oper.adb @@ -345,8 +345,10 @@ package body Synth.Oper is end Synth_Compare_Sgn_Sgn; begin - Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Left_Type); - Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Right_Type); + Left := Synth_Expression_With_Type + (Syn_Inst, Left_Expr, Get_Value_Type (Syn_Inst, Left_Type)); + Right := Synth_Expression_With_Type + (Syn_Inst, Right_Expr, Get_Value_Type (Syn_Inst, Right_Type)); case Def is when Iir_Predefined_Error => diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 999c585c2..e6a65d465 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -36,7 +36,6 @@ with PSL.Nodes; with PSL.NFAs; with PSL.Errors; -with Synth.Types; use Synth.Types; with Synth.Errors; use Synth.Errors; with Synth.Decls; use Synth.Decls; with Synth.Expr; use Synth.Expr; @@ -54,7 +53,7 @@ package body Synth.Stmts is function Synth_Waveform (Syn_Inst : Synth_Instance_Acc; Wf : Node; - Targ_Type : Node) return Value_Acc is + Targ_Type : Type_Acc) return Value_Acc is begin if Get_Kind (Wf) = Iir_Kind_Unaffected_Waveform then -- TODO @@ -68,7 +67,7 @@ package body Synth.Stmts is -- Warning null; end if; - if Targ_Type = Null_Node then + if Targ_Type = null then return Synth_Expression (Syn_Inst, Get_We_Value (Wf)); else return Synth_Expression_With_Type @@ -89,19 +88,17 @@ package body Synth.Stmts is procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc; Target : Node; + Target_Type : Type_Acc; Val : Value_Acc; Loc : Node) is - Targ_Type : constant Node := Get_Type (Target); - Bnd : Bound_Type; Choice : Node; Assoc : Node; Pos : Uns32; begin - if Is_Vector_Type (Targ_Type) then - Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 0); + if Target_Type.Kind = Type_Vector then Choice := Get_Association_Choices_Chain (Target); - Pos := Bnd.Len; + Pos := Target_Type.W; while Is_Valid (Choice) loop Assoc := Get_Associated_Expr (Choice); case Get_Kind (Choice) is @@ -204,14 +201,53 @@ package body Synth.Stmts is end case; end Synth_Assignment_Prefix; - procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; - Target : Node; - Val : Value_Acc; - Loc : Node) is + type Target_Kind is + (Target_Simple, Target_Aggregate, Target_Memory); + + type Target_Info (Kind : Target_Kind := Target_Simple) is record + -- In all cases, the type of the target is known or computed. + Targ_Type : Type_Acc; + + case Kind is + when Target_Simple => + -- For a simple target, the destination is known. + Wid : Wire_Id; + Off : Uns32; + when Target_Aggregate => + -- For an aggregate: the type is computed and the details will + -- be handled at the assignment. + Aggr : Node; + when Target_Memory => + -- For a memory: the destination is known. + Mem_Wid : Wire_Id; + Mem_Off : Uns32; + Mem_Val : Net; + end case; + end record; + + function Synth_Target (Syn_Inst : Synth_Instance_Acc; + Target : Node) return Target_Info is begin case Get_Kind (Target) is when Iir_Kind_Aggregate => - Synth_Assignment_Aggregate (Syn_Inst, Target, Val, Loc); + declare + Targ_Type : constant Node := Get_Type (Target); + Base_Typ : Type_Acc; + Bnd : Bound_Type; + begin + Base_Typ := + Get_Value_Type (Syn_Inst, Get_Base_Type (Targ_Type)); + case Base_Typ.Kind is + when Type_Unbounded_Vector => + Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 0); + return Target_Info' (Kind => Target_Aggregate, + Targ_Type => Create_Vector_Type + (Bnd, Base_Typ.Uvec_El), + Aggr => Target); + when others => + raise Internal_Error; + end case; + end; when Iir_Kind_Simple_Name | Iir_Kind_Selected_Element | Iir_Kind_Interface_Signal_Declaration @@ -224,13 +260,17 @@ package body Synth.Stmts is Typ : Type_Acc; begin Synth_Assignment_Prefix (Syn_Inst, Target, Wid, Off, Typ); - Synth_Assign (Wid, Typ, Val, Off, Loc); + return Target_Info'(Kind => Target_Simple, + Targ_Type => Typ, + Wid => Wid, + Off => Off); end; when Iir_Kind_Indexed_Name => declare Wid : Wire_Id; Off : Uns32; Typ : Type_Acc; + El_Typ : Type_Acc; Voff : Net; Mul : Uns32; @@ -244,20 +284,27 @@ package body Synth.Stmts is Wid, Off, Typ); Synth_Indexed_Name (Syn_Inst, Target, Typ, Voff, Mul, Idx_Off, W); + El_Typ := Get_Array_Element (Typ); if Voff = No_Net then -- FIXME: check index. pragma Assert (Mul = 0); - Synth_Assign (Wid, Get_Array_Element (Typ), - Val, Off + Idx_Off, Loc); + return Target_Info'(Kind => Target_Simple, + Targ_Type => El_Typ, + Wid => Wid, + Off => Off + Idx_Off); else Targ_Net := Get_Current_Assign_Value (Build_Context, Wid, Off, Get_Type_Width (Typ)); V := Build_Dyn_Insert - (Build_Context, Targ_Net, Get_Net (Val), + (Build_Context, Targ_Net, No_Net, Voff, Mul, Int32 (Idx_Off)); Set_Location (V, Target); - Synth_Assign (Wid, Typ, Create_Value_Net (V, Typ), Off, Loc); + return Target_Info'(Kind => Target_Memory, + Targ_Type => El_Typ, + Mem_Wid => Wid, + Mem_Off => Off, + Mem_Val => V); end if; end; when Iir_Kind_Slice_Name => @@ -285,55 +332,90 @@ package body Synth.Stmts is Targ_Net := Get_Current_Assign_Value (Build_Context, Wid, Off, Get_Type_Width (Typ)); V := Build_Dyn_Insert - (Build_Context, Targ_Net, Get_Net (Val), + (Build_Context, Targ_Net, No_Net, Inp, Step, Sl_Off); Set_Location (V, Target); - Synth_Assign - (Wid, Res_Type, Create_Value_Net (V, Res_Type), Off, Loc); + return Target_Info'(Kind => Target_Memory, + Targ_Type => Res_Type, + Mem_Wid => Wid, + Mem_Off => Off, + Mem_Val => V); else - Synth_Assign (Wid, Res_Type, Val, Off + Uns32 (Sl_Off), Loc); + return Target_Info'(Kind => Target_Simple, + Targ_Type => Res_Type, + Wid => Wid, + Off => Off + Uns32 (Sl_Off)); end if; end; when others => - Error_Kind ("synth_assignment", Target); + Error_Kind ("synth_target", Target); end case; + end Synth_Target; + + procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; + Target : Target_Info; + Val : Value_Acc; + Loc : Node) is + begin + case Target.Kind is + when Target_Aggregate => + Synth_Assignment_Aggregate + (Syn_Inst, Target.Aggr, Target.Targ_Type, Val, Loc); + when Target_Simple => + Synth_Assign (Target.Wid, Target.Targ_Type, Val, Target.Off, Loc); + when Target_Memory => + declare + Inst : constant Instance := Get_Net_Parent (Target.Mem_Val); + begin + Connect (Get_Input (Inst, 1), Get_Net (Val)); + Synth_Assign + (Target.Mem_Wid, Target.Targ_Type, + Create_Value_Net (Target.Mem_Val, Target.Targ_Type), + Target.Mem_Off, Loc); + end; + end case; + end Synth_Assignment; + + procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; + Target : Node; + Val : Value_Acc; + Loc : Node) + is + Info : Target_Info; + begin + Info := Synth_Target (Syn_Inst, Target); + Synth_Assignment (Syn_Inst, Info, Val, Loc); end Synth_Assignment; -- Concurrent or sequential simple signal assignment procedure Synth_Simple_Signal_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is - Target : constant Node := Get_Target (Stmt); - Wf_Type : Node; + Targ : Target_Info; Val : Value_Acc; begin - -- FIXME: correctly handle target type when it is a slice. - case Get_Kind (Target) is - when Iir_Kind_Slice_Name - | Iir_Kind_Aggregate => - Wf_Type := Null_Node; - when others => - Wf_Type := Get_Type (Target); - end case; - Val := Synth_Waveform (Syn_Inst, Get_Waveform_Chain (Stmt), Wf_Type); - Synth_Assignment (Syn_Inst, Target, Val, Stmt); + Targ := Synth_Target (Syn_Inst, Get_Target (Stmt)); + Val := Synth_Waveform + (Syn_Inst, Get_Waveform_Chain (Stmt), Targ.Targ_Type); + Synth_Assignment (Syn_Inst, Targ, Val, Stmt); end Synth_Simple_Signal_Assignment; procedure Synth_Conditional_Signal_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is - Target : constant Node := Get_Target (Stmt); - Targ_Type : constant Node := Get_Type (Target); + Targ : Target_Info; Cond : Node; Cwf : Node; Val, Cond_Val : Value_Acc; First, Last : Net; V : Net; begin + Targ := Synth_Target (Syn_Inst, Get_Target (Stmt)); Last := No_Net; Cwf := Get_Conditional_Waveform_Chain (Stmt); while Cwf /= Null_Node loop - Val := Synth_Waveform (Syn_Inst, Get_Waveform_Chain (Cwf), Targ_Type); + Val := Synth_Waveform + (Syn_Inst, Get_Waveform_Chain (Cwf), Targ.Targ_Type); V := Get_Net (Val); Cond := Get_Condition (Cwf); if Cond /= Null_Node then @@ -352,32 +434,34 @@ package body Synth.Stmts is Last := V; Cwf := Get_Chain (Cwf); end loop; - Val := Create_Value_Net (First, Get_Value_Type (Syn_Inst, Targ_Type)); - Synth_Assignment (Syn_Inst, Target, Val, Stmt); + Val := Create_Value_Net (First, Targ.Targ_Type); + Synth_Assignment (Syn_Inst, Targ, Val, Stmt); end Synth_Conditional_Signal_Assignment; procedure Synth_Variable_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is - Target : constant Node := Get_Target (Stmt); + Targ : Target_Info; Val : Value_Acc; begin + Targ := Synth_Target (Syn_Inst, Get_Target (Stmt)); Val := Synth_Expression_With_Type - (Syn_Inst, Get_Expression (Stmt), Get_Type (Target)); - Synth_Assignment (Syn_Inst, Target, Val, Stmt); + (Syn_Inst, Get_Expression (Stmt), Targ.Targ_Type); + Synth_Assignment (Syn_Inst, Targ, Val, Stmt); end Synth_Variable_Assignment; procedure Synth_Conditional_Variable_Assignment (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Target : constant Node := Get_Target (Stmt); - Targ_Type : constant Node := Get_Type (Target); + Targ_Type : Type_Acc; Cond : Node; Ce : Node; Val, Cond_Val : Value_Acc; V : Net; First, Last : Net; begin + Targ_Type := Get_Value_Type (Syn_Inst, Get_Type (Target)); Last := No_Net; Ce := Get_Conditional_Expression_Chain (Stmt); while Ce /= Null_Node loop @@ -399,7 +483,7 @@ package body Synth.Stmts is Last := V; Ce := Get_Chain (Ce); end loop; - Val := Create_Value_Net (First, Get_Value_Type (Syn_Inst, Targ_Type)); + Val := Create_Value_Net (First, Targ_Type); Synth_Assignment (Syn_Inst, Target, Val, Stmt); end Synth_Conditional_Variable_Assignment; @@ -972,12 +1056,13 @@ package body Synth.Stmts is use Vhdl.Sem_Expr; Targ : constant Node := Get_Target (Stmt); - Targ_Type : constant Node := Get_Type (Targ); Expr : constant Node := Get_Expression (Stmt); Choices : constant Node := Get_Selected_Waveform_Chain (Stmt); Choice : Node; + Targ_Type : Type_Acc; + Case_Info : Choice_Info_Type; Annex_Arr : Annex_Array_Acc; @@ -995,6 +1080,7 @@ package body Synth.Stmts is Sel : Value_Acc; Sel_Net : Net; begin + Targ_Type := Get_Value_Type (Syn_Inst, Get_Type (Targ)); -- Create a net for the expression. Sel := Synth_Expression (Syn_Inst, Expr); @@ -1088,10 +1174,9 @@ package body Synth.Stmts is -- Generate the muxes tree. Synth_Case (Sel_Net, Case_El.all, Default, Res); - Synth_Assignment - (Syn_Inst, Get_Target (Stmt), - Create_Value_Net (Res, Get_Value_Type (Syn_Inst, Targ_Type)), - Stmt); + Synth_Assignment (Syn_Inst, Get_Target (Stmt), + Create_Value_Net (Res, Targ_Type), + Stmt); end; -- free. @@ -1107,7 +1192,7 @@ package body Synth.Stmts is Assoc_Chain : Node) is Inter : Node; - Inter_Type : Node; + Inter_Type : Type_Acc; Assoc : Node; Assoc_Inter : Node; Actual : Node; @@ -1117,7 +1202,7 @@ package body Synth.Stmts is Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop Inter := Get_Association_Interface (Assoc, Assoc_Inter); - Inter_Type := Get_Type (Inter); + Inter_Type := Get_Value_Type (Subprg_Inst, Get_Type (Inter)); case Iir_Parameter_Modes (Get_Mode (Inter)) is when Iir_In_Mode => @@ -1138,8 +1223,7 @@ package body Synth.Stmts is raise Internal_Error; end case; - Val := Synth_Subtype_Conversion - (Val, Get_Value_Type (Subprg_Inst, Inter_Type), True, Assoc); + Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc); case Iir_Kinds_Interface_Object_Declaration (Get_Kind (Inter)) is when Iir_Kind_Interface_Constant_Declaration @@ -1173,8 +1257,7 @@ package body Synth.Stmts is Inter := Get_Association_Interface (Assoc, Assoc_Inter); if Get_Mode (Inter) = Iir_Out_Mode then - Val := Synth_Expression_With_Type - (Subprg_Inst, Inter, Get_Type (Inter)); + Val := Synth_Expression (Subprg_Inst, Inter); Synth_Assignment (Caller_Inst, Get_Actual (Assoc), Val, Assoc); end if; |