aboutsummaryrefslogtreecommitdiffstats
path: root/src/synth
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2019-09-12 05:11:25 +0200
committerTristan Gingold <tgingold@free.fr>2019-09-12 05:11:25 +0200
commit8f1870143c4020196c7610e590079ee8b9b2f7d3 (patch)
tree96e11dde462c862794adaacba24c7da702cb99b7 /src/synth
parent02a659969acd638adc14c5af7d62bd25097646f5 (diff)
downloadghdl-8f1870143c4020196c7610e590079ee8b9b2f7d3.tar.gz
ghdl-8f1870143c4020196c7610e590079ee8b9b2f7d3.tar.bz2
ghdl-8f1870143c4020196c7610e590079ee8b9b2f7d3.zip
synth: extract synth-oper from synth-expr
Diffstat (limited to 'src/synth')
-rw-r--r--src/synth/synth-expr.adb927
-rw-r--r--src/synth/synth-expr.ads6
-rw-r--r--src/synth/synth-oper.adb938
-rw-r--r--src/synth/synth-oper.ads39
-rw-r--r--src/synth/synth-values.adb26
-rw-r--r--src/synth/synth-values.ads3
6 files changed, 1012 insertions, 927 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)
diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads
index 9292ab105..adcf96885 100644
--- a/src/synth/synth-expr.ads
+++ b/src/synth/synth-expr.ads
@@ -29,7 +29,6 @@ with Synth.Context; use Synth.Context;
with Vhdl.Nodes; use Vhdl.Nodes;
package Synth.Expr is
- function Is_Const (Val : Value_Acc) return Boolean;
function Get_Width (Val : Value_Acc) return Uns32;
procedure Set_Location (N : Net; Loc : Node);
@@ -76,6 +75,11 @@ package Synth.Expr is
function Synth_Float_Range_Expression
(Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type;
+ procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc;
+ Bound : Node;
+ Rng : out Discrete_Range_Type;
+ W : out Width);
+
-- Convert index IDX in PFX to an offset. LOC is used in case of error.
function Index_To_Offset (Bnd : Bound_Type; Idx : Int64; Loc : Node)
return Uns32;
diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb
new file mode 100644
index 000000000..7bd75e2b6
--- /dev/null
+++ b/src/synth/synth-oper.adb
@@ -0,0 +1,938 @@
+-- Operations synthesis.
+-- Copyright (C) 2019 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software; you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+-- MA 02110-1301, USA.
+
+with Ada.Unchecked_Conversion;
+with Types; use Types;
+with Types_Utils; use Types_Utils;
+with Mutils; use Mutils;
+with Vhdl.Ieee.Std_Logic_1164; use Vhdl.Ieee.Std_Logic_1164;
+with Vhdl.Std_Package;
+with Vhdl.Errors; use Vhdl.Errors;
+with Vhdl.Utils; use Vhdl.Utils;
+
+with Areapools;
+with Vhdl.Annotations; use Vhdl.Annotations;
+
+with Netlists; use Netlists;
+with Netlists.Gates; use Netlists.Gates;
+with Netlists.Builders; use Netlists.Builders;
+
+with Synth.Errors; use Synth.Errors;
+with Synth.Types; use Synth.Types;
+with Synth.Stmts; use Synth.Stmts;
+with Synth.Expr; use Synth.Expr;
+
+package body Synth.Oper 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_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;
+
+ 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_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_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 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_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;
+end Synth.Oper;
diff --git a/src/synth/synth-oper.ads b/src/synth/synth-oper.ads
new file mode 100644
index 000000000..69fbb232d
--- /dev/null
+++ b/src/synth/synth-oper.ads
@@ -0,0 +1,39 @@
+-- Operations synthesis.
+-- Copyright (C) 2019 Tristan Gingold
+--
+-- This file is part of GHDL.
+--
+-- This program is free software; you can redistribute it and/or modify
+-- it under the terms of the GNU General Public License as published by
+-- the Free Software Foundation; either version 2 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+-- GNU General Public License for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with this program; if not, write to the Free Software
+-- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
+-- MA 02110-1301, USA.
+
+with Synth.Values; use Synth.Values;
+with Synth.Context; use Synth.Context;
+with Vhdl.Nodes; use Vhdl.Nodes;
+
+package Synth.Oper is
+ function Synth_Predefined_Function_Call
+ (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc;
+
+ function Synth_Dyadic_Operation (Syn_Inst : Synth_Instance_Acc;
+ Imp : Node;
+ Left_Expr : Node;
+ Right_Expr : Node;
+ Expr : Node) return Value_Acc;
+
+ function Synth_Monadic_Operation (Syn_Inst : Synth_Instance_Acc;
+ Def : Iir_Predefined_Functions;
+ Operand_Expr : Node;
+ Loc : Node) return Value_Acc;
+end Synth.Oper;
diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb
index a8932501e..8ce6bad34 100644
--- a/src/synth/synth-values.adb
+++ b/src/synth/synth-values.adb
@@ -37,6 +37,32 @@ package body Synth.Values is
function To_Value_Array_Acc is new Ada.Unchecked_Conversion
(System.Address, Values.Value_Array_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 Is_Bounded_Type (Typ : Type_Acc) return Boolean is
begin
case Typ.Kind is
diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads
index e8f20d9f8..d3af338ab 100644
--- a/src/synth/synth-values.ads
+++ b/src/synth/synth-values.ads
@@ -240,6 +240,9 @@ package Synth.Values is
function Is_Bounded_Type (Typ : Type_Acc) return Boolean;
+ function Is_Const (Val : Value_Acc) return Boolean;
+ function Is_Float (Val : Value_Acc) return Boolean;
+
function Is_Equal (L, R : Value_Acc) return Boolean;
-- Create a Value_Net.