diff options
Diffstat (limited to 'src/synth/synth-expr.adb')
| -rw-r--r-- | src/synth/synth-expr.adb | 927 |
1 files changed, 1 insertions, 926 deletions
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 7d2004f91..03bb1e3e0 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -29,51 +29,21 @@ with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Evaluation; use Vhdl.Evaluation; -with Areapools; with Vhdl.Annotations; use Vhdl.Annotations; with Synth.Errors; use Synth.Errors; with Synth.Types; use Synth.Types; with Synth.Stmts; use Synth.Stmts; +with Synth.Oper; use Synth.Oper; with Netlists.Gates; use Netlists.Gates; with Netlists.Builders; use Netlists.Builders; with Netlists.Locations; use Netlists.Locations; package body Synth.Expr is - -- As log2(3m) is directly referenced, the program must be linked with -lm - -- (math library) on unix systems. - pragma Linker_Options ("-lm"); - function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Value_Acc; - function Is_Const (Val : Value_Acc) return Boolean is - begin - case Val.Kind is - when Value_Discrete => - return True; - when Value_Net - | Value_Wire - | Value_Mux2 => - return False; - when Value_Const_Array - | Value_Const_Record => - return True; - when Value_Array - | Value_Record => - return False; - when others => - -- TODO. - raise Internal_Error; - end case; - end Is_Const; - - function Is_Float (Val : Value_Acc) return Boolean is - begin - return Val.Kind = Value_Float; - end Is_Float; - function Get_Width (Val : Value_Acc) return Uns32 is begin case Val.Kind is @@ -168,61 +138,6 @@ package body Synth.Expr is end case; end Bit_Extract; - function Synth_Uresize (N : Net; W : Width; Loc : Node) return Net - is - Wn : constant Width := Get_Width (N); - Res : Net; - begin - if Wn = W then - return N; - else - if Wn > W then - Res := Build_Trunc (Build_Context, Id_Utrunc, N, W); - else - pragma Assert (Wn < W); - Res := Build_Extend (Build_Context, Id_Uextend, N, W); - end if; - Set_Location (Res, Loc); - return Res; - end if; - end Synth_Uresize; - - function Synth_Sresize (N : Net; W : Width; Loc : Node) return Net - is - Wn : constant Width := Get_Width (N); - Res : Net; - begin - if Wn = W then - return N; - else - if Wn > W then - Res := Build_Trunc (Build_Context, Id_Strunc, N, W); - else - pragma Assert (Wn < W); - Res := Build_Extend (Build_Context, Id_Sextend, N, W); - end if; - Set_Location (Res, Loc); - return Res; - end if; - end Synth_Sresize; - - function Synth_Uresize (Val : Value_Acc; W : Width; Loc : Node) return Net - is - Res : Net; - begin - if Is_Const (Val) and then Val.Typ.Kind = Type_Discrete then - if Val.Typ.Drange.Is_Signed then - -- TODO. - raise Internal_Error; - else - Res := Build2_Const_Uns (Build_Context, To_Uns64 (Val.Scal), W); - end if; - Set_Location (Res, Loc); - return Res; - end if; - return Synth_Uresize (Get_Net (Val), W, Loc); - end Synth_Uresize; - -- Resize for a discrete value. function Synth_Resize (Val : Value_Acc; W : Width; Loc : Node) return Net is @@ -815,91 +730,6 @@ package body Synth.Expr is return Create_Value_Const_Array (Res_Type, Arr); end Synth_Simple_Aggregate; - function Synth_Bit_Eq_Const (Cst : Value_Acc; Expr : Value_Acc; Loc : Node) - return Value_Acc - is - Val : Uns32; - Zx : Uns32; - N : Net; - begin - if Is_Const (Expr) then - return Create_Value_Discrete (Boolean'Pos (Cst.Scal = Expr.Scal), - Boolean_Type); - end if; - - To_Logic (Cst.Scal, Cst.Typ, Val, Zx); - if Zx /= 0 then - -- Equal unknown -> return X - N := Build_Const_UL32 (Build_Context, 0, 1, 1); - Set_Location (N, Loc); - 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)); - Set_Location (N, Loc); - 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 Type_Acc - is - Res : Type_Acc; - Wd : Width; - begin - Res := Prev.Typ; - - 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_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 Bound_Type - is - Res : Bound_Type; - Index_Bounds : Discrete_Range_Type; - W : Width; - begin - Synth_Discrete_Range (Syn_Inst, Atype, Index_Bounds, W); - - Res := (Left => Int32 (Index_Bounds.Left), - Right => 0, - Dir => Index_Bounds.Dir, - Wbounds => W, - Wlen => Width (Clog2 (Uns64 (Len))), - Len => Uns32 (Len)); - - if Len = 0 then - -- Special case. - Res.Right := Res.Left; - 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.Dir is - when Iir_To => - Res.Right := Res.Left + Int32 (Len - 1); - when Iir_Downto => - Res.Right := Res.Left - Int32 (Len - 1); - end case; - end if; - return Res; - end Create_Bounds_From_Length; - function Synth_Subtype_Conversion (Val : Value_Acc; Dtype : Type_Acc; Loc : Source.Syn_Src) return Value_Acc @@ -979,591 +809,6 @@ package body Synth.Expr is end case; end Synth_Subtype_Conversion; - -- Implicit conversion of literals. - function Synth_Dyadic_Operation (Syn_Inst : Synth_Instance_Acc; - 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); - Left_Type : constant Node := Get_Type (Inter_Chain); - Right_Type : constant Node := Get_Type (Get_Chain (Inter_Chain)); - Left : Value_Acc; - Right : Value_Acc; - - function Synth_Bit_Dyadic (Id : Dyadic_Module_Id) return Value_Acc - is - N : Net; - begin - N := Build_Dyadic (Build_Context, Id, - Get_Net (Left), Get_Net (Right)); - Set_Location (N, Expr); - return Create_Value_Net (N, Left.Typ); - end Synth_Bit_Dyadic; - - function Synth_Compare (Id : Compare_Module_Id) return Value_Acc - is - N : Net; - L, R : Value_Acc; - Typ : Type_Acc; - begin - pragma Assert (Left_Type = Right_Type); - Typ := Get_Value_Type (Syn_Inst, Left_Type); - L := Synth_Subtype_Conversion (Left, Typ, Expr); - R := Synth_Subtype_Conversion (Right, Typ, Expr); - N := Build_Compare (Build_Context, Id, Get_Net (L), Get_Net (R)); - Set_Location (N, Expr); - return Create_Value_Net (N, Boolean_Type); - end Synth_Compare; - - function Synth_Compare_Uns_Nat (Id : Compare_Module_Id) - return Value_Acc - is - N : Net; - begin - N := Synth_Uresize (Right, Get_Width (Left), Expr); - N := Build_Compare (Build_Context, Id, Get_Net (Left), N); - Set_Location (N, Expr); - 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); - N : Net; - begin - 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; - - function Synth_Int_Dyadic (Id : Dyadic_Module_Id) return Value_Acc - is - Etype : constant Type_Acc := Get_Value_Type (Syn_Inst, Expr_Type); - N : Net; - begin - 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; - - function Synth_Dyadic_Uns (Id : Dyadic_Module_Id; Is_Res_Vec : Boolean) - return Value_Acc - is - L : constant Net := Get_Net (Left); - R : constant Net := Get_Net (Right); - W : constant Width := Width'Max (Get_Width (L), Get_Width (R)); - Rtype : Type_Acc; - L1, R1 : Net; - N : Net; - begin - if Is_Res_Vec then - Rtype := Create_Vec_Type_By_Length (W, Left.Typ.Vec_El); - else - Rtype := Left.Typ; - end if; - L1 := Synth_Uresize (L, W, Expr); - R1 := Synth_Uresize (R, W, Expr); - N := Build_Dyadic (Build_Context, Id, L1, R1); - Set_Location (N, Expr); - return Create_Value_Net (N, Rtype); - end Synth_Dyadic_Uns; - - function Synth_Dyadic_Sgn (Id : Dyadic_Module_Id; Is_Res_Vec : Boolean) - return Value_Acc - is - L : constant Net := Get_Net (Left); - R : constant Net := Get_Net (Right); - W : constant Width := Width'Max (Get_Width (L), Get_Width (R)); - Rtype : Type_Acc; - L1, R1 : Net; - N : Net; - begin - if Is_Res_Vec then - Rtype := Create_Vec_Type_By_Length (W, Left.Typ.Vec_El); - else - Rtype := Left.Typ; - end if; - L1 := Synth_Sresize (L, W, Expr); - R1 := Synth_Sresize (R, W, Expr); - N := Build_Dyadic (Build_Context, Id, L1, R1); - Set_Location (N, Expr); - return Create_Value_Net (N, Rtype); - end Synth_Dyadic_Sgn; - - function Synth_Compare_Uns_Uns (Id : Compare_Module_Id) - return Value_Acc - is - 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; - begin - L1 := Synth_Uresize (L, W, Expr); - R1 := Synth_Uresize (R, W, Expr); - N := Build_Compare (Build_Context, Id, L1, R1); - Set_Location (N, Expr); - 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); - R1 : Net; - N : Net; - begin - R1 := Synth_Uresize (Right, Get_Width (Left), 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; - - function Synth_Compare_Sgn_Sgn (Id : Compare_Module_Id) - return Value_Acc - is - 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; - begin - L1 := Synth_Sresize (L, W, Expr); - R1 := Synth_Sresize (R, W, Expr); - N := Build_Compare (Build_Context, Id, L1, R1); - Set_Location (N, Expr); - return Create_Value_Net (N, Boolean_Type); - 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); - - case Def is - when Iir_Predefined_Error => - return null; - - when Iir_Predefined_Bit_And - | Iir_Predefined_Boolean_And - | Iir_Predefined_Ieee_1164_Scalar_And => - return Synth_Bit_Dyadic (Id_And); - when Iir_Predefined_Bit_Xor - | Iir_Predefined_Ieee_1164_Scalar_Xor => - return Synth_Bit_Dyadic (Id_Xor); - when Iir_Predefined_Bit_Or - | Iir_Predefined_Boolean_Or - | Iir_Predefined_Ieee_1164_Scalar_Or => - return Synth_Bit_Dyadic (Id_Or); - when Iir_Predefined_Bit_Nor - | Iir_Predefined_Ieee_1164_Scalar_Nor => - return Synth_Bit_Dyadic (Id_Nor); - when Iir_Predefined_Bit_Nand - | Iir_Predefined_Ieee_1164_Scalar_Nand => - return Synth_Bit_Dyadic (Id_Nand); - when Iir_Predefined_Bit_Xnor - | Iir_Predefined_Ieee_1164_Scalar_Xnor => - return Synth_Bit_Dyadic (Id_Xnor); - - when Iir_Predefined_Ieee_1164_Vector_And - | Iir_Predefined_Ieee_Numeric_Std_And_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_And_Sgn_Sgn => - return Synth_Vec_Dyadic (Id_And); - when Iir_Predefined_Ieee_1164_Vector_Or - | Iir_Predefined_Ieee_Numeric_Std_Or_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Or_Sgn_Sgn => - return Synth_Vec_Dyadic (Id_Or); - when Iir_Predefined_Ieee_1164_Vector_Nand - | Iir_Predefined_Ieee_Numeric_Std_Nand_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Nand_Sgn_Sgn => - return Synth_Vec_Dyadic (Id_Nand); - when Iir_Predefined_Ieee_1164_Vector_Nor - | Iir_Predefined_Ieee_Numeric_Std_Nor_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Nor_Sgn_Sgn => - return Synth_Vec_Dyadic (Id_Nor); - when Iir_Predefined_Ieee_1164_Vector_Xor - | Iir_Predefined_Ieee_Numeric_Std_Xor_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Xor_Sgn_Sgn => - return Synth_Vec_Dyadic (Id_Xor); - when Iir_Predefined_Ieee_1164_Vector_Xnor - | Iir_Predefined_Ieee_Numeric_Std_Xnor_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Xnor_Sgn_Sgn => - return Synth_Vec_Dyadic (Id_Xnor); - - when Iir_Predefined_Enum_Equality => - 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 - return Synth_Bit_Eq_Const (Right, Left, Expr); - end if; - end if; - return Synth_Compare (Id_Eq); - when Iir_Predefined_Enum_Inequality => - -- TODO: Optimize ? - return Synth_Compare (Id_Ne); - when Iir_Predefined_Enum_Less_Equal => - return Synth_Compare (Id_Ult); - - when Iir_Predefined_Array_Equality => - -- TODO: check size, handle non-vector. - 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 (Left_Type) then - return Synth_Compare (Id_Ne); - else - raise Internal_Error; - end if; - when Iir_Predefined_Array_Greater => - -- TODO: check size, non-vector. - -- TODO: that's certainly not the correct operator. - if Is_Vector_Type (Left_Type) then - return Synth_Compare (Id_Ugt); - else - raise Internal_Error; - end if; - - when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Nat => - -- "+" (Unsigned, Natural) - return Synth_Dyadic_Uns_Nat (Id_Add); - when Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Uns - | Iir_Predefined_Ieee_Numeric_Std_Add_Uns_Log - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Add_Slv_Sl => - -- "+" (Unsigned, Unsigned) - return Synth_Dyadic_Uns (Id_Add, True); - when Iir_Predefined_Ieee_Numeric_Std_Add_Sgn_Sgn => - -- "+" (Signed, Signed) - return Synth_Dyadic_Sgn (Id_Add, True); - when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Nat => - -- "-" (Unsigned, Natural) - return Synth_Dyadic_Uns_Nat (Id_Sub); - when Iir_Predefined_Ieee_Numeric_Std_Sub_Uns_Uns => - -- "-" (Unsigned, Unsigned) - return Synth_Dyadic_Uns (Id_Sub, True); - - when Iir_Predefined_Ieee_Numeric_Std_Mul_Sgn_Sgn => - declare - L : constant Net := Get_Net (Left); - R : constant Net := Get_Net (Right); - W : constant Width := Get_Width (L) + Get_Width (R); - Rtype : Type_Acc; - N : Net; - begin - Rtype := Create_Vec_Type_By_Length (W, Left.Typ.Vec_El); - N := Build_Dyadic (Build_Context, Id_Smul, L, R); - Set_Location (N, Expr); - return Create_Value_Net (N, Rtype); - end; - - when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Nat => - -- "=" (Unsigned, Natural) - return Synth_Compare_Uns_Nat (Id_Eq); - when Iir_Predefined_Ieee_Numeric_Std_Eq_Uns_Uns - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Eq_Slv_Slv => - -- "=" (Unsigned, Unsigned) [resize] - return Synth_Compare_Uns_Uns (Id_Eq); - - when Iir_Predefined_Ieee_Numeric_Std_Ne_Uns_Uns - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Ne_Slv_Slv => - -- "/=" (Unsigned, Unsigned) [resize] - return Synth_Compare_Uns_Uns (Id_Ne); - when Iir_Predefined_Ieee_Numeric_Std_Ne_Uns_Nat => - -- "/=" (Unsigned, Natural) - return Synth_Compare_Uns_Nat (Id_Ne); - - when Iir_Predefined_Ieee_Numeric_Std_Lt_Uns_Nat => - -- "<" (Unsigned, Natural) - if Is_Const (Right) and then Right.Scal = 0 then - -- Always false. - 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 - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Lt_Slv_Slv => - -- "<" (Unsigned, Unsigned) [resize] - return Synth_Compare_Uns_Uns (Id_Ult); - when Iir_Predefined_Ieee_Numeric_Std_Lt_Sgn_Sgn => - -- "<" (Signed, Signed) [resize] - return Synth_Compare_Sgn_Sgn (Id_Slt); - - when Iir_Predefined_Ieee_Numeric_Std_Le_Uns_Uns - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Le_Slv_Slv => - -- "<=" (Unsigned, Unsigned) [resize] - return Synth_Compare_Uns_Uns (Id_Ule); - - when Iir_Predefined_Ieee_Numeric_Std_Gt_Uns_Nat => - -- ">" (Unsigned, Natural) - return Synth_Compare_Uns_Nat (Id_Ugt); - when Iir_Predefined_Ieee_Numeric_Std_Gt_Uns_Uns - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Gt_Slv_Slv => - -- ">" (Unsigned, Unsigned) [resize] - return Synth_Compare_Uns_Uns (Id_Ugt); - when Iir_Predefined_Ieee_Numeric_Std_Gt_Sgn_Sgn => - -- ">" (Signed, Signed) [resize] - return Synth_Compare_Sgn_Sgn (Id_Sgt); - - when Iir_Predefined_Ieee_Numeric_Std_Ge_Uns_Uns - | Iir_Predefined_Ieee_Std_Logic_Unsigned_Ge_Slv_Slv => - -- ">=" (Unsigned, Unsigned) [resize] - return Synth_Compare_Uns_Uns (Id_Uge); - - when Iir_Predefined_Array_Element_Concat => - declare - L : constant Net := Get_Net (Left); - Bnd : Bound_Type; - N : Net; - begin - 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_Vector_Type (Bnd, Right.Typ)); - end; - when Iir_Predefined_Element_Array_Concat => - declare - R : constant Net := Get_Net (Right); - Bnd : Bound_Type; - N : Net; - begin - 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_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), 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_Vector_Type (Bnd, Left.Typ)); - end; - when Iir_Predefined_Array_Array_Concat => - declare - 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_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, - Get_Value_Type (Syn_Inst, Get_Type (Expr))); - else - return Synth_Int_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, - Get_Value_Type (Syn_Inst, Get_Type (Expr))); - else - return Synth_Int_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, - Get_Value_Type (Syn_Inst, Get_Type (Expr))); - else - return Synth_Int_Dyadic (Id_Smul); - 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, - 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, - Get_Value_Type (Syn_Inst, Get_Type (Expr))); - else - Error_Msg_Synth (+Expr, "non-constant mod not supported"); - return null; - end if; - when Iir_Predefined_Integer_Rem => - if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete - (Left.Scal rem Right.Scal, - Get_Value_Type (Syn_Inst, Get_Type (Expr))); - else - Error_Msg_Synth (+Expr, "non-constant rem not supported"); - return null; - end if; - when Iir_Predefined_Integer_Exp => - if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete - (Left.Scal ** Natural (Right.Scal), - Get_Value_Type (Syn_Inst, Get_Type (Expr))); - else - Error_Msg_Synth - (+Expr, "non-constant exponentiation not supported"); - return null; - end if; - 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_Type); - else - return Synth_Compare (Id_Sle); - end if; - when Iir_Predefined_Integer_Less => - if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete - (Boolean'Pos (Left.Scal < Right.Scal), Boolean_Type); - else - return Synth_Compare (Id_Slt); - end if; - when Iir_Predefined_Integer_Greater_Equal => - if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete - (Boolean'Pos (Left.Scal >= Right.Scal), Boolean_Type); - else - return Synth_Compare (Id_Sge); - end if; - when Iir_Predefined_Integer_Greater => - if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete - (Boolean'Pos (Left.Scal > Right.Scal), Boolean_Type); - else - return Synth_Compare (Id_Sgt); - 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_Type); - else - return Synth_Compare (Id_Eq); - end if; - when Iir_Predefined_Integer_Inequality => - if Is_Const (Left) and then Is_Const (Right) then - return Create_Value_Discrete - (Boolean'Pos (Left.Scal /= Right.Scal), Boolean_Type); - else - return Synth_Compare (Id_Ne); - end if; - when Iir_Predefined_Physical_Physical_Div => - if Is_Const (Left) and then Is_Const (Right) then - 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 others => - Error_Msg_Synth (+Expr, "synth_dyadic_operation: unhandled " - & Iir_Predefined_Functions'Image (Def)); - raise Internal_Error; - end case; - end Synth_Dyadic_Operation; - - function Synth_Monadic_Operation (Syn_Inst : Synth_Instance_Acc; - Def : Iir_Predefined_Functions; - Operand_Expr : Node; - Loc : Node) return Value_Acc - is - Operand : Value_Acc; - - function Synth_Bit_Monadic (Id : Monadic_Module_Id) return Value_Acc - is - N : Net; - begin - N := Build_Monadic (Build_Context, Id, Get_Net (Operand)); - Set_Location (N, Loc); - return Create_Value_Net (N, Operand.Typ); - end Synth_Bit_Monadic; - - function Synth_Vec_Monadic (Id : Monadic_Module_Id) return Value_Acc - is - Op: constant Net := Get_Net (Operand); - N : Net; - begin - N := Build_Monadic (Build_Context, Id, Op); - Set_Location (N, Loc); - return Create_Value_Net (N, Create_Res_Bound (Operand, Op)); - end Synth_Vec_Monadic; - - function Synth_Vec_Reduce_Monadic (Id : Reduce_Module_Id) - return Value_Acc - is - Op: constant Net := Get_Net (Operand); - N : Net; - begin - N := Build_Reduce (Build_Context, Id, Op); - Set_Location (N, Loc); - return Create_Value_Net (N, Operand.Typ.Vec_El); - end Synth_Vec_Reduce_Monadic; - begin - Operand := Synth_Expression (Syn_Inst, Operand_Expr); - case Def is - when Iir_Predefined_Error => - return null; - when Iir_Predefined_Ieee_1164_Scalar_Not => - return Synth_Bit_Monadic (Id_Not); - when Iir_Predefined_Ieee_1164_Vector_Not - | Iir_Predefined_Ieee_Numeric_Std_Not_Uns - | Iir_Predefined_Ieee_Numeric_Std_Not_Sgn => - return Synth_Vec_Monadic (Id_Not); - when Iir_Predefined_Ieee_Numeric_Std_Neg_Uns - | Iir_Predefined_Ieee_Numeric_Std_Neg_Sgn => - return Synth_Vec_Monadic (Id_Neg); - when Iir_Predefined_Ieee_1164_Vector_And_Reduce => - return Synth_Vec_Reduce_Monadic(Id_Red_And); - when Iir_Predefined_Ieee_1164_Vector_Or_Reduce => - return Synth_Vec_Reduce_Monadic(Id_Red_Or); - when Iir_Predefined_Ieee_1164_Condition_Operator => - return Operand; - when others => - Error_Msg_Synth - (+Loc, - "unhandled monadic: " & Iir_Predefined_Functions'Image (Def)); - raise Internal_Error; - end case; - end Synth_Monadic_Operation; - function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) return Value_Acc is begin @@ -2188,174 +1433,6 @@ package body Synth.Expr is return Res; end Synth_String_Literal; - function Eval_To_Unsigned (Arg : Int64; Sz : Int64; Res_Type : Type_Acc) - return Value_Acc - is - Len : constant Iir_Index32 := Iir_Index32 (Sz); - El_Type : constant Type_Acc := Get_Array_Element (Res_Type); - Arr : Value_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, El_Type); - end loop; - Bnd := Create_Vec_Type_By_Length (Width (Len), El_Type); - return Create_Value_Const_Array (Bnd, Arr); - end Eval_To_Unsigned; - - function Synth_Shift (Id : Shift_Module_Id; - Left, Right : Value_Acc; - Expr : Node) return Value_Acc - is - L : constant Net := Get_Net (Left); - N : Net; - begin - N := Build_Shift (Build_Context, Id, L, Get_Net (Right)); - Set_Location (N, Expr); - return Create_Value_Net (N, Create_Res_Bound (Left, L)); - end Synth_Shift; - - function Synth_Predefined_Function_Call - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc - is - Imp : constant Node := Get_Implementation (Expr); - Def : constant Iir_Predefined_Functions := - Get_Implicit_Definition (Imp); - Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Expr); - Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); - Subprg_Inst : Synth_Instance_Acc; - M : Areapools.Mark_Type; - begin - Areapools.Mark (M, Instance_Pool.all); - Subprg_Inst := Make_Instance (Syn_Inst, Get_Info (Imp)); - - Synth_Subprogram_Association - (Subprg_Inst, Syn_Inst, Inter_Chain, Assoc_Chain); - - case Def is - when Iir_Predefined_Ieee_Numeric_Std_Touns_Nat_Nat_Uns => - declare - Arg : constant Value_Acc := Subprg_Inst.Objects (1); - Size : constant Value_Acc := Subprg_Inst.Objects (2); - Arg_Net : Net; - begin - if not Is_Const (Size) then - Error_Msg_Synth (+Expr, "to_unsigned size must be constant"); - return Arg; - else - -- FIXME: what if the arg is constant too ? - if Is_Const (Arg) then - return Eval_To_Unsigned - (Arg.Scal, Size.Scal, - Get_Value_Type (Syn_Inst, Get_Type (Imp))); - else - Arg_Net := Get_Net (Arg); - return Create_Value_Net - (Synth_Uresize (Arg_Net, Uns32 (Size.Scal), Expr), - Create_Res_Bound (Arg, Arg_Net)); - end if; - end if; - end; - when Iir_Predefined_Ieee_Numeric_Std_Toint_Uns_Nat => - -- UNSIGNED to Natural. - declare - Int_Type : constant Type_Acc := - Get_Value_Type (Syn_Inst, - Vhdl.Std_Package.Integer_Subtype_Definition); - begin - return Create_Value_Net - (Synth_Uresize (Get_Net (Subprg_Inst.Objects (1)), - Int_Type.W, Expr), - Int_Type); - end; - when Iir_Predefined_Ieee_Numeric_Std_Resize_Uns_Nat => - declare - V : constant Value_Acc := Subprg_Inst.Objects (1); - Sz : constant Value_Acc := Subprg_Inst.Objects (2); - W : Width; - begin - if not Is_Const (Sz) then - Error_Msg_Synth (+Expr, "size must be constant"); - return null; - end if; - W := Uns32 (Sz.Scal); - return Create_Value_Net - (Synth_Uresize (Get_Net (V), W, Expr), - Create_Vec_Type_By_Length (W, Logic_Type)); - end; - when Iir_Predefined_Ieee_Numeric_Std_Resize_Sgn_Nat => - declare - V : constant Value_Acc := Subprg_Inst.Objects (1); - Sz : constant Value_Acc := Subprg_Inst.Objects (2); - W : Width; - begin - if not Is_Const (Sz) then - Error_Msg_Synth (+Expr, "size must be constant"); - return null; - end if; - W := Uns32 (Sz.Scal); - return Create_Value_Net - (Synth_Sresize (Get_Net (V), W, Expr), - Create_Vec_Type_By_Length (W, Logic_Type)); - end; - when Iir_Predefined_Ieee_Numeric_Std_Shl_Uns_Nat => - declare - L : constant Value_Acc := Subprg_Inst.Objects (1); - R : constant Value_Acc := Subprg_Inst.Objects (2); - begin - return Synth_Shift (Id_Lsl, L, R, Expr); - end; - when Iir_Predefined_Ieee_Numeric_Std_Shr_Uns_Nat => - declare - L : constant Value_Acc := Subprg_Inst.Objects (1); - R : constant Value_Acc := Subprg_Inst.Objects (2); - begin - return Synth_Shift (Id_Lsr, L, R, Expr); - end; - when Iir_Predefined_Ieee_Math_Real_Log2 => - declare - V : constant Value_Acc := Subprg_Inst.Objects (1); - - function Log2 (Arg : Fp64) return Fp64; - pragma Import (C, Log2); - begin - if not Is_Float (V) then - Error_Msg_Synth - (+Expr, "argument must be a float value"); - return null; - end if; - return Create_Value_Float - (Log2 (V.Fp), Get_Value_Type (Syn_Inst, Get_Type (Imp))); - end; - when Iir_Predefined_Ieee_Math_Real_Ceil => - declare - V : constant Value_Acc := Subprg_Inst.Objects (1); - - function Ceil (Arg : Fp64) return Fp64; - pragma Import (C, Ceil); - begin - if not Is_Float (V) then - Error_Msg_Synth - (+Expr, "argument must be a float value"); - return null; - end if; - return Create_Value_Float - (Ceil (V.Fp), Get_Value_Type (Syn_Inst, Get_Type (Imp))); - end; - when others => - Error_Msg_Synth - (+Expr, - "unhandled function: " & Iir_Predefined_Functions'Image (Def)); - end case; - - Free_Instance (Subprg_Inst); - Areapools.Release (M, Instance_Pool.all); - - return null; - end Synth_Predefined_Function_Call; - function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Node) return Value_Acc @@ -2552,8 +1629,6 @@ package body Synth.Expr is when others => Error_Kind ("synth_expression_with_type", Expr); end case; - raise Fatal_Error; - return null; end Synth_Expression_With_Type; function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) |