From 6ee126fe715834c13cabf661030b5f76a11d6fd3 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 5 Aug 2019 07:36:32 +0200 Subject: synth: handle subtype conversions. --- src/synth/synth-expr.adb | 143 +++++++++++++++++++++++++++++++--------------- src/synth/synth-expr.ads | 5 ++ src/synth/synth-insts.adb | 7 ++- src/synth/synth-stmts.adb | 69 ++++++++++++++-------- src/synth/synth-stmts.ads | 3 +- 5 files changed, 154 insertions(+), 73 deletions(-) diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index cda931798..c3f1f2589 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -705,41 +705,95 @@ package body Synth.Expr is return Res; end Create_Bounds_From_Length; - -- Implicit conversion of literals. - function Synth_Implicit_Conv (Syn_Inst : Synth_Instance_Acc; - Val : Value_Acc; - Vtype : Node; - Rtype : Node) return Value_Acc + function Synth_Subtype_Conversion + (Val : Value_Acc; Dtype : Type_Acc; Loc : Source.Syn_Src) + return Value_Acc is - Vtyp : Type_Acc; - Rtyp : Type_Acc; + Vtype : constant Type_Acc := Val.Typ; begin - if Rtype = Vtype or else Val.Kind /= Value_Discrete then - return Val; - end if; - if Vtype /= Vhdl.Std_Package.Convertible_Integer_Type_Definition then - raise Internal_Error; - end if; - Vtyp := Val.Typ; - Rtyp := Get_Value_Type (Syn_Inst, Rtype); - if Rtyp.Drange.W < Vtyp.Drange.W then - -- TODO: check bounds. - return Create_Value_Discrete (Val.Scal, Rtyp); - else - pragma Assert (Vtyp.Drange.W = Rtyp.Drange.W); - return Val; - end if; - end Synth_Implicit_Conv; + case Dtype.Kind is + when Type_Bit => + pragma Assert (Vtype.Kind = Type_Bit); + return Val; + when Type_Discrete => + pragma Assert (Vtype.Kind = Type_Discrete); + declare + Vrng : Discrete_Range_Type renames Vtype.Drange; + Drng : Discrete_Range_Type renames Dtype.Drange; + N : Net; + begin + if Vrng.W > Drng.W then + -- Truncate. + -- TODO: check overflow. + case Val.Kind is + when Value_Net + | Value_Wire => + N := Get_Net (Val); + N := Build_Trunc (Build_Context, Id_Utrunc, N, Drng.W); + Set_Location (N, Loc); + return Create_Value_Net (N, Dtype); + when others => + raise Internal_Error; + end case; + elsif Vrng.W < Drng.W then + -- Extend. + case Val.Kind is + when Value_Discrete => + return Create_Value_Discrete (Val.Scal, Dtype); + when Value_Net + | Value_Wire => + N := Get_Net (Val); + if Vrng.Is_Signed then + N := Build_Extend + (Build_Context, Id_Sextend, N, Drng.W); + else + N := Build_Extend + (Build_Context, Id_Uextend, N, Drng.W); + end if; + Set_Location (N, Loc); + return Create_Value_Net (N, Dtype); + when others => + raise Internal_Error; + end case; + else + -- TODO: check overflow if sign differ. + return Val; + end if; + end; + when Type_Float => + pragma Assert (Vtype.Kind = Type_Float); + -- TODO: check range + return Val; + when Type_Vector => + -- TODO: check width + return Val; + when Type_Array => + -- TODO: check bounds, handle elements + return Val; + when Type_Unbounded_Array => + pragma Assert (Vtype.Kind = Type_Vector + or else Vtype.Kind = Type_Array); + return Val; + when Type_Record => + -- TODO: handle elements. + return Val; + end case; + end Synth_Subtype_Conversion; + -- Implicit conversion of literals. function Synth_Dyadic_Operation (Syn_Inst : Synth_Instance_Acc; - Def : Iir_Predefined_Functions; + Imp : Node; Left_Expr : Node; Right_Expr : Node; Expr : Node) return Value_Acc is + Def : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); + Inter_Chain : constant Node := + Get_Interface_Declaration_Chain (Imp); Expr_Type : constant Node := Get_Type (Expr); - Ltype : constant Node := Get_Type (Left_Expr); - Rtype : constant Node := Get_Type (Right_Expr); + Left_Type : constant Node := Get_Type (Inter_Chain); + Right_Type : constant Node := Get_Type (Get_Chain (Inter_Chain)); Left : Value_Acc; Right : Value_Acc; @@ -768,7 +822,7 @@ package body Synth.Expr is is N : Net; begin - N := Synth_Uresize (Right, Rtype, Get_Width (Left)); + N := Synth_Uresize (Right, Right_Type, Get_Width (Left)); Set_Location (N, Expr); N := Build_Compare (Build_Context, Id, Get_Net (Left), N); Set_Location (N, Expr); @@ -788,15 +842,10 @@ package body Synth.Expr is function Synth_Int_Dyadic (Id : Dyadic_Module_Id) return Value_Acc is Etype : constant Type_Acc := Get_Value_Type (Syn_Inst, Expr_Type); - L, R : Net; N : Net; begin - Left := Synth_Implicit_Conv (Syn_Inst, Left, Ltype, Expr_Type); - Right := Synth_Implicit_Conv (Syn_Inst, Right, Rtype, Expr_Type); - - L := Synth_Resize (Left, Etype.Drange.W, Expr); - R := Synth_Resize (Right, Etype.Drange.W, Expr); - N := Build_Dyadic (Build_Context, Id, L, R); + N := Build_Dyadic + (Build_Context, Id, Get_Net (Left), Get_Net (Right)); Set_Location (N, Expr); return Create_Value_Net (N, Etype); end Synth_Int_Dyadic; @@ -849,15 +898,15 @@ package body Synth.Expr is R1 : Net; N : Net; begin - R1 := Synth_Uresize (Right, Rtype, Get_Width (Left)); + R1 := Synth_Uresize (Right, Right_Type, Get_Width (Left)); Set_Location (R1, Expr); N := Build_Dyadic (Build_Context, Id, L, R1); Set_Location (N, Expr); return Create_Value_Net (N, Create_Res_Bound (Left, L)); end Synth_Dyadic_Uns_Nat; begin - Left := Synth_Expression (Syn_Inst, Left_Expr); - Right := Synth_Expression (Syn_Inst, Right_Expr); + Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Left_Type); + Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Right_Type); case Def is when Iir_Predefined_Error => @@ -892,8 +941,8 @@ package body Synth.Expr is return Synth_Vec_Dyadic (Id_Xor); when Iir_Predefined_Enum_Equality => - if Is_Bit_Type (Ltype) then - pragma Assert (Is_Bit_Type (Rtype)); + if Is_Bit_Type (Left_Type) then + pragma Assert (Is_Bit_Type (Right_Type)); if Is_Const (Left) then return Synth_Bit_Eq_Const (Left, Right, Expr); elsif Is_Const (Right) then @@ -909,14 +958,14 @@ package body Synth.Expr is when Iir_Predefined_Array_Equality => -- TODO: check size, handle non-vector. - if Is_Vector_Type (Ltype) then + if Is_Vector_Type (Left_Type) then return Synth_Compare (Id_Eq); else raise Internal_Error; end if; when Iir_Predefined_Array_Inequality => -- TODO: check size, handle non-vector. - if Is_Vector_Type (Ltype) then + if Is_Vector_Type (Left_Type) then return Synth_Compare (Id_Ne); else raise Internal_Error; @@ -924,7 +973,7 @@ package body Synth.Expr is when Iir_Predefined_Array_Greater => -- TODO: check size, non-vector. -- TODO: that's certainly not the correct operator. - if Is_Vector_Type (Ltype) then + if Is_Vector_Type (Left_Type) then return Synth_Compare (Id_Ugt); else raise Internal_Error; @@ -1979,7 +2028,9 @@ package body Synth.Expr is function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Node) - return Value_Acc is + return Value_Acc + is + Res : Value_Acc; begin case Get_Kind (Expr) is when Iir_Kinds_Dyadic_Operator => @@ -2002,7 +2053,7 @@ package body Synth.Expr is or else Def in Iir_Predefined_IEEE_Explicit then return Synth_Dyadic_Operation - (Syn_Inst, Def, Get_Left (Expr), Get_Right (Expr), Expr); + (Syn_Inst, Imp, Get_Left (Expr), Get_Right (Expr), Expr); else Error_Unknown_Operator (Imp, Expr); raise Internal_Error; @@ -2026,7 +2077,9 @@ package body Synth.Expr is end; when Iir_Kind_Simple_Name | Iir_Kind_Interface_Signal_Declaration => -- For PSL... - return Synth_Name (Syn_Inst, Expr); + Res := Synth_Name (Syn_Inst, Expr); + return Synth_Subtype_Conversion + (Res, Get_Value_Type (Syn_Inst, Expr_Type), Expr); when Iir_Kind_Reference_Name => return Synth_Name (Syn_Inst, Get_Named_Entity (Expr)); when Iir_Kind_Indexed_Name => diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index f7edc2417..be6daba0d 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -21,6 +21,7 @@ with Ada.Unchecked_Deallocation; with Types; use Types; with Netlists; use Netlists; +with Synth.Source; with Synth.Values; use Synth.Values; with Synth.Context; use Synth.Context; with Vhdl.Nodes; use Vhdl.Nodes; @@ -32,6 +33,10 @@ package Synth.Expr is procedure Set_Location (N : Net; Loc : Node); pragma Inline (Set_Location); + function Synth_Subtype_Conversion + (Val : Value_Acc; Dtype : Type_Acc; Loc : Source.Syn_Src) + return Value_Acc; + procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32); procedure From_Bit (Enum : Int64; Val : out Uns32); procedure To_Logic diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 721671e1e..74d0673f5 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -307,7 +307,7 @@ package body Synth.Insts is Port := Builders.Build_Port (Build_Context, Port); O := Create_Value_Net (Port, Get_Value_Type (Inst_Obj.Syn_Inst, Get_Type (Inter))); - Synth_Assignment (Syn_Inst, Actual, O); + Synth_Assignment (Syn_Inst, Actual, O, Assoc); Nbr_Outputs := Nbr_Outputs + 1; end case; Next_Association_Interface (Assoc, Assoc_Inter); @@ -577,8 +577,9 @@ package body Synth.Insts is | Port_Inout => Port := Get_Output (Inst, Nbr_Outputs); Port := Builders.Build_Port (Build_Context, Port); - O := Create_Value_Net (Port, null); - Synth_Assignment (Syn_Inst, Actual, O); + O := Create_Value_Net + (Port, Get_Value_Type (Syn_Inst, Get_Type (Inter))); + Synth_Assignment (Syn_Inst, Actual, O, Assoc); Nbr_Outputs := Nbr_Outputs + 1; end case; Next_Association_Interface (Assoc, Assoc_Inter); diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 8facedb95..f3623960a 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -41,6 +41,7 @@ with Synth.Decls; use Synth.Decls; with Synth.Expr; use Synth.Expr; with Synth.Environment; use Synth.Environment; with Synth.Insts; use Synth.Insts; +with Synth.Source; with Vhdl.Annotations; use Vhdl.Annotations; @@ -65,19 +66,27 @@ package body Synth.Stmts is -- Warning null; end if; - return Synth_Expression_With_Type - (Syn_Inst, Get_We_Value (Wf), Targ_Type); + if Targ_Type = Null_Node then + return Synth_Expression (Syn_Inst, Get_We_Value (Wf)); + else + return Synth_Expression_With_Type + (Syn_Inst, Get_We_Value (Wf), Targ_Type); + end if; end Synth_Waveform; - procedure Synth_Assign (Dest : Value_Acc; Val : Value_Acc) is + procedure Synth_Assign + (Dest : Value_Acc; Val : Value_Acc; Loc : Source.Syn_Src) is begin pragma Assert (Dest.Kind = Value_Wire); - Phi_Assign (Dest.W, Get_Net (Val)); + Phi_Assign + (Dest.W, + Get_Net (Synth_Subtype_Conversion (Val, Dest.Typ, Loc))); end Synth_Assign; procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc; Target : Node; - Val : Value_Acc) + Val : Value_Acc; + Loc : Node) is Targ_Type : constant Node := Get_Type (Target); Bnd : Bound_Type; @@ -95,7 +104,7 @@ package body Synth.Stmts is when Iir_Kind_Choice_By_None => Pos := Pos - 1; Synth_Assignment - (Syn_Inst, Assoc, Bit_Extract (Val, Pos, Target)); + (Syn_Inst, Assoc, Bit_Extract (Val, Pos, Target), Loc); when others => Error_Kind ("synth_assignment_aggregate", Choice); end case; @@ -106,8 +115,10 @@ package body Synth.Stmts is end if; end Synth_Assignment_Aggregate; - procedure Synth_Indexed_Assignment - (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc) + procedure Synth_Indexed_Assignment (Syn_Inst : Synth_Instance_Acc; + Target : Node; + Val : Value_Acc; + Loc : Node) is Pfx : constant Node := Get_Prefix (Target); Targ : constant Value_Acc := Get_Value (Syn_Inst, Get_Base_Name (Pfx)); @@ -136,24 +147,26 @@ package body Synth.Stmts is (Build_Context, Targ_Net, Val_Net, Voff, Mul, Int32 (Off)); Set_Location (V, Target); end if; - Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ)); + Synth_Assign (Targ, Create_Value_Net (V, Targ.Typ), Loc); end Synth_Indexed_Assignment; - procedure Synth_Assignment - (Syn_Inst : Synth_Instance_Acc; Target : Node; Val : Value_Acc) is + procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; + Target : Node; + Val : Value_Acc; + Loc : Node) is begin case Get_Kind (Target) is when Iir_Kind_Simple_Name => - Synth_Assignment (Syn_Inst, Get_Named_Entity (Target), Val); + Synth_Assignment (Syn_Inst, Get_Named_Entity (Target), Val, Loc); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Anonymous_Signal_Declaration => - Synth_Assign (Get_Value (Syn_Inst, Target), Val); + Synth_Assign (Get_Value (Syn_Inst, Target), Val, Loc); when Iir_Kind_Aggregate => - Synth_Assignment_Aggregate (Syn_Inst, Target, Val); + Synth_Assignment_Aggregate (Syn_Inst, Target, Val, Loc); when Iir_Kind_Indexed_Name => - Synth_Indexed_Assignment (Syn_Inst, Target, Val); + Synth_Indexed_Assignment (Syn_Inst, Target, Val, Loc); when Iir_Kind_Slice_Name => declare Pfx : constant Node := Get_Prefix (Target); @@ -186,7 +199,7 @@ package body Synth.Stmts is end if; Set_Location (Res, Target); Res_Type := Create_Vector_Type (Res_Bnd, Targ.Typ.Vec_El); - Synth_Assign (Targ, Create_Value_Net (Res, Res_Type)); + Synth_Assign (Targ, Create_Value_Net (Res, Res_Type), Loc); end; when others => Error_Kind ("synth_assignment", Target); @@ -198,11 +211,17 @@ package body Synth.Stmts is (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Target : constant Node := Get_Target (Stmt); + Wf_Type : Node; Val : Value_Acc; begin - Val := Synth_Waveform - (Syn_Inst, Get_Waveform_Chain (Stmt), Get_Type (Target)); - Synth_Assignment (Syn_Inst, Target, Val); + -- FIXME: correctly handle target type when it is a slice. + if Get_Kind (Target) = Iir_Kind_Slice_Name then + Wf_Type := Null_Node; + else + Wf_Type := Get_Type (Target); + end if; + Val := Synth_Waveform (Syn_Inst, Get_Waveform_Chain (Stmt), Wf_Type); + Synth_Assignment (Syn_Inst, Target, Val, Stmt); end Synth_Simple_Signal_Assignment; procedure Synth_Conditional_Signal_Assignment @@ -233,7 +252,7 @@ package body Synth.Stmts is Last := Val; Cwf := Get_Chain (Cwf); end loop; - Synth_Assignment (Syn_Inst, Target, First); + Synth_Assignment (Syn_Inst, Target, First, Stmt); end Synth_Conditional_Signal_Assignment; procedure Synth_Variable_Assignment @@ -244,7 +263,7 @@ package body Synth.Stmts is begin Val := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Stmt), Get_Type (Target)); - Synth_Assignment (Syn_Inst, Target, Val); + Synth_Assignment (Syn_Inst, Target, Val, Stmt); end Synth_Variable_Assignment; procedure Synth_If_Statement @@ -895,8 +914,10 @@ 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, null)); + Synth_Assignment + (Syn_Inst, Get_Target (Stmt), + Create_Value_Net (Res, Get_Value_Type (Syn_Inst, Targ_Type)), + Stmt); end; -- free. @@ -977,7 +998,7 @@ package body Synth.Stmts is if Get_Mode (Inter) = Iir_Out_Mode then Val := Synth_Expression_With_Type (Subprg_Inst, Inter, Get_Type (Inter)); - Synth_Assignment (Caller_Inst, Get_Actual (Assoc), Val); + Synth_Assignment (Caller_Inst, Get_Actual (Assoc), Val, Assoc); end if; diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index 296e639e4..85f3eaa9f 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -31,7 +31,8 @@ package Synth.Stmts is procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Node; - Val : Value_Acc); + Val : Value_Acc; + Loc : Node); procedure Synth_Sequential_Statements (Syn_Inst : Synth_Instance_Acc; Stmts : Node); -- cgit v1.2.3