diff options
Diffstat (limited to 'src/synth/synth-vhdl_expr.adb')
| -rw-r--r-- | src/synth/synth-vhdl_expr.adb | 2572 |
1 files changed, 2572 insertions, 0 deletions
diff --git a/src/synth/synth-vhdl_expr.adb b/src/synth/synth-vhdl_expr.adb new file mode 100644 index 000000000..9b2072865 --- /dev/null +++ b/src/synth/synth-vhdl_expr.adb @@ -0,0 +1,2572 @@ +-- Expressions synthesis. +-- Copyright (C) 2017 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, see <gnu.org/licenses>. + +with Types_Utils; use Types_Utils; +with Name_Table; +with Std_Names; +with Str_Table; +with Mutils; use Mutils; +with Errorout; use Errorout; + +with Vhdl.Types; +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 Vhdl.Evaluation; use Vhdl.Evaluation; +with Vhdl.Annotations; use Vhdl.Annotations; + +with PSL.Nodes; +with PSL.Errors; + +with Netlists.Gates; use Netlists.Gates; +with Netlists.Folds; use Netlists.Folds; +with Netlists.Utils; use Netlists.Utils; +with Netlists.Locations; + +with Synth.Memtype; use Synth.Memtype; +with Synth.Errors; use Synth.Errors; +with Synth.Vhdl_Environment; +with Synth.Vhdl_Decls; +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; +with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; +with Synth.Vhdl_Heap; use Synth.Vhdl_Heap; +with Synth.Debugger; +with Synth.Vhdl_Aggr; + +with Grt.Types; +with Grt.To_Strings; + +package body Synth.Vhdl_Expr is + function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) + return Valtyp; + + procedure Set_Location (N : Net; Loc : Node) + renames Synth.Source.Set_Location; + + function Get_Value_Memtyp (V : Valtyp) return Memtyp is + begin + case V.Val.Kind is + when Value_Memory => + return (V.Typ, V.Val.Mem); + when Value_Const => + return Get_Memtyp (V); + when Value_Wire => + return Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W); + when Value_Alias => + declare + Res : Memtyp; + begin + Res := Get_Value_Memtyp ((V.Val.A_Typ, V.Val.A_Obj)); + return (V.Typ, Res.Mem + V.Val.A_Off.Mem_Off); + end; + when others => + raise Internal_Error; + end case; + end Get_Value_Memtyp; + + function Get_Static_Discrete (V : Valtyp) return Int64 is + begin + case V.Val.Kind is + when Value_Memory => + return Read_Discrete (V); + when Value_Const => + return Read_Discrete (Get_Memtyp (V)); + when Value_Wire => + return Read_Discrete + (Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W)); + when others => + raise Internal_Error; + end case; + end Get_Static_Discrete; + + function Is_Positive (V : Valtyp) return Boolean + is + N : Net; + Inst : Instance; + begin + pragma Assert (V.Typ.Kind = Type_Discrete); + case V.Val.Kind is + when Value_Const + | Value_Memory => + return Read_Discrete (Get_Memtyp (V)) >= 0; + when Value_Net => + N := V.Val.N; + when Value_Wire => + if Synth.Vhdl_Environment.Env.Is_Static_Wire (V.Val.W) then + return Read_Discrete + (Synth.Vhdl_Environment.Env.Get_Static_Wire (V.Val.W)) >= 0; + else + return False; + end if; + when others => + raise Internal_Error; + end case; + Inst := Get_Net_Parent (N); + case Get_Id (Inst) is + when Id_Uextend + | Id_Const_UB32 => + return True; + when others => + -- Be conservative. + return False; + end case; + end Is_Positive; + + procedure From_Std_Logic (Enum : Int64; Val : out Uns32; Zx : out Uns32) is + begin + case Enum is + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_L_Pos => + Val := 0; + Zx := 0; + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_H_Pos => + Val := 1; + Zx := 0; + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_U_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_X_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_D_Pos => + Val := 1; + Zx := 1; + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_Z_Pos + | Vhdl.Ieee.Std_Logic_1164.Std_Logic_W_Pos => + Val := 0; + Zx := 1; + when others => + -- Only 9 values. + raise Internal_Error; + end case; + end From_Std_Logic; + + procedure From_Bit (Enum : Int64; Val : out Uns32) is + begin + if Enum = 0 then + Val := 0; + elsif Enum = 1 then + Val := 1; + else + raise Internal_Error; + end if; + end From_Bit; + + procedure To_Logic + (Enum : Int64; Etype : Type_Acc; Val : out Uns32; Zx : out Uns32) is + begin + if Etype = Logic_Type then + pragma Assert (Etype.Kind = Type_Logic); + From_Std_Logic (Enum, Val, Zx); + elsif Etype = Boolean_Type or Etype = Bit_Type then + pragma Assert (Etype.Kind = Type_Bit); + From_Bit (Enum, Val); + Zx := 0; + else + raise Internal_Error; + end if; + end To_Logic; + + procedure Uns2logvec (Val : Uns64; + W : Width; + Vec : in out Logvec_Array; + Off : in out Uns32) is + begin + if W = 0 then + return; + end if; + + for I in 0 .. W - 1 loop + declare + B : constant Uns32 := Uns32 (Shift_Right (Val, Natural (I)) and 1); + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + begin + Vec (Idx).Val := Vec (Idx).Val or Shift_Left (B, Pos); + end; + Off := Off + 1; + end loop; + end Uns2logvec; + + procedure Bit2logvec (Val : Uns32; + Vec : in out Logvec_Array; + Off : in out Uns32) + is + pragma Assert (Val <= 1); + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + Va : Uns32; + begin + Va := Shift_Left (Val, Pos); + Vec (Idx).Val := Vec (Idx).Val or Va; + Vec (Idx).Zx := 0; + Off := Off + 1; + end Bit2logvec; + + procedure Logic2logvec (Val : Int64; + Vec : in out Logvec_Array; + Off : in out Uns32; + Has_Zx : in out Boolean) + is + pragma Assert (Val <= 8); + Idx : constant Digit_Index := Digit_Index (Off / 32); + Pos : constant Natural := Natural (Off mod 32); + Va : Uns32; + Zx : Uns32; + begin + From_Std_Logic (Val, Va, Zx); + Has_Zx := Has_Zx or Zx /= 0; + Va := Shift_Left (Va, Pos); + Zx := Shift_Left (Zx, Pos); + Vec (Idx).Val := Vec (Idx).Val or Va; + Vec (Idx).Zx := Vec (Idx).Zx or Zx; + Off := Off + 1; + end Logic2logvec; + + procedure Value2logvec (Mem : Memory_Ptr; + Typ : Type_Acc; + Off : in out Uns32; + W : in out Width; + Vec : in out Logvec_Array; + Vec_Off : in out Uns32; + Has_Zx : in out Boolean) is + begin + if Off >= Typ.W then + -- Offset not yet reached. + Off := Off - Typ.W; + return; + end if; + if W = 0 then + return; + end if; + + case Typ.Kind is + when Type_Bit => + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Bit2logvec (Uns32 (Read_U8 (Mem)), Vec, Vec_Off); + W := W - Typ.W; + when Type_Logic => + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Logic2logvec (Int64 (Read_U8 (Mem)), Vec, Vec_Off, Has_Zx); + W := W - Typ.W; + when Type_Discrete => + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Uns2logvec (To_Uns64 (Read_Discrete (Memtyp'(Typ, Mem))), + Typ.W, Vec, Vec_Off); + W := W - Typ.W; + when Type_Float => + -- Fp64 is for sure 64 bits. Assume the endianness of floats is + -- the same as integers endianness. + -- Scalar bits cannot be cut. + pragma Assert (Off = 0 and W >= Typ.W); + Uns2logvec (To_Uns64 (Read_Fp64 (Mem)), 64, Vec, Vec_Off); + W := W - Typ.W; + when Type_Vector => + declare + Vlen : Uns32; + begin + Vlen := Uns32 (Vec_Length (Typ)); + pragma Assert (Off < Vlen); + pragma Assert (Vlen > 0); + + if Vlen > Off + W then + Vlen := Off + W; + end if; + case Typ.Vec_El.Kind is + when Type_Bit => + -- TODO: optimize off mod 32 = 0. + for I in reverse Off + 1 .. Vlen loop + Bit2logvec (Uns32 (Read_U8 (Mem + Size_Type (I - 1))), + Vec, Vec_Off); + end loop; + when Type_Logic => + for I in reverse Off + 1 .. Vlen loop + Logic2logvec + (Int64 (Read_U8 (Mem + Size_Type (I - 1))), + Vec, Vec_Off, Has_Zx); + end loop; + when others => + raise Internal_Error; + end case; + W := W - (Vlen - Off); + Off := 0; + end; + when Type_Array => + declare + Alen : constant Iir_Index32 := Get_Array_Flat_Length (Typ); + El_Typ : constant Type_Acc := Typ.Arr_El; + begin + for I in reverse 1 .. Alen loop + Value2logvec (Mem + Size_Type (I - 1) * El_Typ.Sz, El_Typ, + Off, W, Vec, Vec_Off, Has_Zx); + exit when W = 0; + end loop; + end; + when Type_Record => + for I in Typ.Rec.E'Range loop + Value2logvec (Mem + Typ.Rec.E (I).Moff, Typ.Rec.E (I).Typ, + Off, W, Vec, Vec_Off, Has_Zx); + exit when W = 0; + end loop; + when others => + raise Internal_Error; + end case; + end Value2logvec; + + procedure Value2logvec (Val : Memtyp; + Off : Uns32; + W : Width; + Vec : in out Logvec_Array; + Vec_Off : in out Uns32; + Has_Zx : in out Boolean) + is + Off1 : Uns32; + W1 : Width; + begin + Off1 := Off; + W1 := W; + Value2logvec (Val.Mem, Val.Typ, Off1, W1, Vec, Vec_Off, Has_Zx); + pragma Assert (Off1 = 0); + pragma Assert (W1 = 0); + end Value2logvec; + + -- Resize for a discrete value. + function Synth_Resize + (Ctxt : Context_Acc; Val : Valtyp; W : Width; Loc : Node) return Net + is + Wn : constant Width := Val.Typ.W; + N : Net; + Res : Net; + V : Int64; + begin + if Is_Static (Val.Val) + and then Wn /= W + then + -- Optimization: resize directly. + V := Read_Discrete (Val); + if Val.Typ.Drange.Is_Signed then + Res := Build2_Const_Int (Ctxt, V, W); + else + Res := Build2_Const_Uns (Ctxt, To_Uns64 (V), W); + end if; + Set_Location (Res, Loc); + return Res; + end if; + + N := Get_Net (Ctxt, Val); + if Wn > W then + return Build2_Trunc (Ctxt, Id_Utrunc, N, W, Get_Location (Loc)); + elsif Wn < W then + if Val.Typ.Drange.Is_Signed then + Res := Build_Extend (Ctxt, Id_Sextend, N, W); + else + Res := Build_Extend (Ctxt, Id_Uextend, N, W); + end if; + Set_Location (Res, Loc); + return Res; + else + return N; + end if; + end Synth_Resize; + + procedure Concat_Array (Ctxt : Context_Acc; Arr : in out Net_Array) + is + Last : Int32; + Idx, New_Idx : Int32; + begin + Last := Arr'Last; + while Last > Arr'First loop + Idx := Arr'First; + New_Idx := Arr'First - 1; + while Idx <= Last loop + -- Gather at most 4 nets. + New_Idx := New_Idx + 1; + + if Idx = Last then + Arr (New_Idx) := Arr (Idx); + Idx := Idx + 1; + elsif Idx + 1 = Last then + Arr (New_Idx) := Build_Concat2 + (Ctxt, Arr (Idx), Arr (Idx + 1)); + Idx := Idx + 2; + elsif Idx + 2 = Last then + Arr (New_Idx) := Build_Concat3 + (Ctxt, Arr (Idx), Arr (Idx + 1), Arr (Idx + 2)); + Idx := Idx + 3; + else + Arr (New_Idx) := Build_Concat4 + (Ctxt, + Arr (Idx), Arr (Idx + 1), Arr (Idx + 2), Arr (Idx + 3)); + Idx := Idx + 4; + end if; + end loop; + Last := New_Idx; + end loop; + end Concat_Array; + + procedure Concat_Array + (Ctxt : Context_Acc; Arr : in out Net_Array; N : out Net) is + begin + Concat_Array (Ctxt, Arr); + N := Arr (Arr'First); + end Concat_Array; + + function Build_Discrete_Range_Type + (L : Int64; R : Int64; Dir : Direction_Type) return Discrete_Range_Type is + begin + return (Dir => Dir, + Left => L, + Right => R, + Is_Signed => L < 0 or R < 0); + end Build_Discrete_Range_Type; + + function Synth_Discrete_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type + is + L, R : Valtyp; + Lval, Rval : Int64; + begin + -- Static values. + L := Synth_Expression_With_Basetype (Syn_Inst, Get_Left_Limit (Rng)); + R := Synth_Expression_With_Basetype (Syn_Inst, Get_Right_Limit (Rng)); + Strip_Const (L); + Strip_Const (R); + + if not (Is_Static (L.Val) and Is_Static (R.Val)) then + Error_Msg_Synth (+Rng, "limits of range are not constant"); + Set_Error (Syn_Inst); + return (Dir => Get_Direction (Rng), + Left => 0, + Right => 0, + Is_Signed => False); + end if; + + Lval := Read_Discrete (L); + Rval := Read_Discrete (R); + return Build_Discrete_Range_Type (Lval, Rval, Get_Direction (Rng)); + end Synth_Discrete_Range_Expression; + + function Synth_Float_Range_Expression + (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type + is + L, R : Valtyp; + begin + -- Static values (so no enable). + L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); + R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng)); + return (Get_Direction (Rng), Read_Fp64 (L), Read_Fp64 (R)); + end Synth_Float_Range_Expression; + + -- Return the type of EXPR without evaluating it. + function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node) + return Type_Acc is + begin + case Get_Kind (Expr) is + when Iir_Kinds_Object_Declaration => + declare + Val : constant Valtyp := Get_Value (Syn_Inst, Expr); + begin + return Val.Typ; + end; + when Iir_Kind_Simple_Name => + return Synth_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr)); + when Iir_Kind_Slice_Name => + declare + Pfx_Typ : Type_Acc; + Pfx_Bnd : Bound_Type; + El_Typ : Type_Acc; + Res_Bnd : Bound_Type; + Sl_Voff : Net; + Sl_Off : Value_Offsets; + begin + Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); + Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ); + Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, + Res_Bnd, Sl_Voff, Sl_Off); + + if Sl_Voff /= No_Net then + raise Internal_Error; + end if; + return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd); + end; + when Iir_Kind_Indexed_Name => + declare + Pfx_Typ : Type_Acc; + begin + Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); + return Get_Array_Element (Pfx_Typ); + end; + when Iir_Kind_Selected_Element => + declare + Idx : constant Iir_Index32 := + Get_Element_Position (Get_Named_Entity (Expr)); + Pfx_Typ : Type_Acc; + begin + Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); + return Pfx_Typ.Rec.E (Idx + 1).Typ; + end; + + when Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + declare + Val : Valtyp; + Res : Valtyp; + begin + -- Maybe do not dereference it if its type is known ? + Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr)); + Res := Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + return Res.Typ; + end; + + when Iir_Kind_String_Literal8 => + -- TODO: the value should be computed (once) and its type + -- returned. + return Synth.Vhdl_Decls.Synth_Subtype_Indication + (Syn_Inst, Get_Type (Expr)); + + when others => + Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr); + end case; + return null; + end Synth_Type_Of_Object; + + function Synth_Array_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Bound_Type + is + Prefix_Name : constant Iir := Get_Prefix (Attr); + Prefix : constant Iir := Strip_Denoting_Name (Prefix_Name); + Dim : constant Natural := + Vhdl.Evaluation.Eval_Attribute_Parameter_Or_1 (Attr); + Typ : Type_Acc; + Val : Valtyp; + begin + -- Prefix is an array object or an array subtype. + if Get_Kind (Prefix) = Iir_Kind_Subtype_Declaration then + -- TODO: does this cover all the cases ? + Typ := Get_Subtype_Object (Syn_Inst, Get_Subtype_Indication (Prefix)); + else + Val := Synth_Expression_With_Basetype (Syn_Inst, Prefix_Name); + Typ := Val.Typ; + end if; + + return Get_Array_Bound (Typ, Dim_Type (Dim)); + end Synth_Array_Attribute; + + procedure Synth_Discrete_Range (Syn_Inst : Synth_Instance_Acc; + Bound : Node; + Rng : out Discrete_Range_Type) is + begin + case Get_Kind (Bound) is + when Iir_Kind_Range_Expression => + Rng := Synth_Discrete_Range_Expression (Syn_Inst, Bound); + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + if Get_Type_Declarator (Bound) /= Null_Node then + declare + Typ : Type_Acc; + begin + -- This is a named subtype, so it has been evaluated. + Typ := Get_Subtype_Object (Syn_Inst, Bound); + Rng := Typ.Drange; + end; + else + Synth_Discrete_Range + (Syn_Inst, Get_Range_Constraint (Bound), Rng); + end if; + when Iir_Kind_Range_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Bound); + Rng := Build_Discrete_Range_Type + (Int64 (B.Left), Int64 (B.Right), B.Dir); + end; + when Iir_Kind_Reverse_Range_Array_Attribute => + declare + B : Bound_Type; + T : Int32; + begin + B := Synth_Array_Attribute (Syn_Inst, Bound); + -- Reverse + case B.Dir is + when Dir_To => + B.Dir := Dir_Downto; + when Dir_Downto => + B.Dir := Dir_To; + end case; + T := B.Right; + B.Right := B.Left; + B.Left := T; + + Rng := Build_Discrete_Range_Type + (Int64 (B.Left), Int64 (B.Right), B.Dir); + end; + when Iir_Kinds_Denoting_Name => + -- A discrete subtype name. + Synth_Discrete_Range + (Syn_Inst, Get_Subtype_Indication (Get_Named_Entity (Bound)), + Rng); + when others => + Error_Kind ("synth_discrete_range", Bound); + end case; + end Synth_Discrete_Range; + + function Synth_Array_Bounds (Syn_Inst : Synth_Instance_Acc; + Atype : Node; + Dim : Dim_Type) return Bound_Type + is + Info : constant Sim_Info_Acc := Get_Info (Atype); + begin + if Info = null then + pragma Assert (Get_Type_Declarator (Atype) = Null_Node); + declare + Index_Type : constant Node := + Get_Index_Type (Atype, Natural (Dim - 1)); + begin + return Synth_Bounds_From_Range (Syn_Inst, Index_Type); + end; + else + declare + Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); + begin + case Bnds.Kind is + when Type_Vector => + pragma Assert (Dim = 1); + return Bnds.Vbound; + when Type_Array => + return Bnds.Abounds.D (Dim); + when others => + raise Internal_Error; + end case; + end; + end if; + end Synth_Array_Bounds; + + function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; + Atype : Node) return Bound_Type + is + Rng : Discrete_Range_Type; + begin + Synth_Discrete_Range (Syn_Inst, Atype, Rng); + return (Dir => Rng.Dir, + Left => Int32 (Rng.Left), Right => Int32 (Rng.Right), + Len => Get_Range_Length (Rng)); + end Synth_Bounds_From_Range; + + function Synth_Bounds_From_Length (Atype : Node; Len : Int32) + return Bound_Type + is + Rng : constant Node := Get_Range_Constraint (Atype); + Limit : Int32; + begin + Limit := Int32 (Eval_Pos (Get_Left_Limit (Rng))); + case Get_Direction (Rng) is + when Dir_To => + return (Dir => Dir_To, + Left => Limit, + Right => Limit + Len - 1, + Len => Uns32 (Len)); + when Dir_Downto => + return (Dir => Dir_Downto, + Left => Limit, + Right => Limit - Len + 1, + Len => Uns32 (Len)); + end case; + end Synth_Bounds_From_Length; + + function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; + Aggr : Node) return Valtyp + is + Aggr_Type : constant Node := Get_Type (Aggr); + pragma Assert (Get_Nbr_Dimensions (Aggr_Type) = 1); + El_Type : constant Node := Get_Element_Subtype (Aggr_Type); + El_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, El_Type); + Els : constant Iir_Flist := Get_Simple_Aggregate_List (Aggr); + Last : constant Natural := Flist_Last (Els); + Bnd : Bound_Type; + Bnds : Bound_Array_Acc; + Res_Type : Type_Acc; + Val : Valtyp; + Res : Valtyp; + begin + -- Allocate the result. + Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 1); + pragma Assert (Bnd.Len = Uns32 (Last + 1)); + + if El_Typ.Kind in Type_Nets then + Res_Type := Create_Vector_Type (Bnd, El_Typ); + else + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res_Type := Create_Array_Type (Bnds, El_Typ); + end if; + + Res := Create_Value_Memory (Res_Type); + + for I in Flist_First .. Last loop + -- Elements are supposed to be static, so no need for enable. + Val := Synth_Expression_With_Type + (Syn_Inst, Get_Nth_Element (Els, I), El_Typ); + pragma Assert (Is_Static (Val.Val)); + Write_Value (Res.Val.Mem + Size_Type (I) * El_Typ.Sz, Val); + end loop; + + return Res; + end Synth_Simple_Aggregate; + + -- Change the bounds of VAL. + function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is + begin + case Val.Val.Kind is + when Value_Wire => + return Create_Value_Wire (Val.Val.W, Ntype); + when Value_Net => + return Create_Value_Net (Val.Val.N, Ntype); + when Value_Alias => + return Create_Value_Alias + ((Val.Val.A_Typ, Val.Val.A_Obj), Val.Val.A_Off, Ntype); + when Value_Const => + return Reshape_Value ((Val.Typ, Val.Val.C_Val), Ntype); + when Value_Memory => + return (Ntype, Val.Val); + when others => + raise Internal_Error; + end case; + end Reshape_Value; + + function Synth_Subtype_Conversion (Ctxt : Context_Acc; + Vt : Valtyp; + Dtype : Type_Acc; + Bounds : Boolean; + Loc : Source.Syn_Src) + return Valtyp + is + Vtype : constant Type_Acc := Vt.Typ; + begin + if Vt = No_Valtyp then + -- Propagate error. + return No_Valtyp; + end if; + if Dtype = Vtype then + return Vt; + end if; + + case Dtype.Kind is + when Type_Bit => + pragma Assert (Vtype.Kind = Type_Bit); + return Vt; + when Type_Logic => + pragma Assert (Vtype.Kind = Type_Logic); + return Vt; + when Type_Discrete => + pragma Assert (Vtype.Kind in Type_All_Discrete); + case Vt.Val.Kind is + when Value_Net + | Value_Wire + | Value_Alias => + if Vtype.W /= Dtype.W then + -- Truncate. + -- TODO: check overflow. + declare + N : Net; + begin + if Is_Static_Val (Vt.Val) then + return Create_Value_Discrete + (Get_Static_Discrete (Vt), Dtype); + end if; + + N := Get_Net (Ctxt, Vt); + if Vtype.Drange.Is_Signed then + N := Build2_Sresize + (Ctxt, N, Dtype.W, Get_Location (Loc)); + else + N := Build2_Uresize + (Ctxt, N, Dtype.W, Get_Location (Loc)); + end if; + return Create_Value_Net (N, Dtype); + end; + else + return Vt; + end if; + when Value_Const => + return Synth_Subtype_Conversion + (Ctxt, (Vt.Typ, Vt.Val.C_Val), Dtype, Bounds, Loc); + when Value_Memory => + -- Check for overflow. + declare + Val : constant Int64 := Read_Discrete (Vt); + begin + if not In_Range (Dtype.Drange, Val) then + Error_Msg_Synth (+Loc, "value out of range"); + return No_Valtyp; + end if; + return Create_Value_Discrete (Val, Dtype); + end; + when others => + raise Internal_Error; + end case; + when Type_Float => + pragma Assert (Vtype.Kind = Type_Float); + -- TODO: check range + return Vt; + when Type_Vector => + pragma Assert (Vtype.Kind = Type_Vector + or Vtype.Kind = Type_Slice); + if Dtype.W /= Vtype.W then + Error_Msg_Synth + (+Loc, "mismatching vector length; got %v, expect %v", + (Errorout."+" (Vtype.W), +Dtype.W)); + return No_Valtyp; + end if; + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; + end if; + when Type_Slice => + -- TODO: check width + return Vt; + when Type_Array => + pragma Assert (Vtype.Kind = Type_Array); + -- Check bounds. + for I in Vtype.Abounds.D'Range loop + if Vtype.Abounds.D (I).Len /= Dtype.Abounds.D (I).Len then + Error_Msg_Synth (+Loc, "mismatching array bounds"); + return No_Valtyp; + end if; + end loop; + -- TODO: check element. + if Bounds then + return Reshape_Value (Vt, Dtype); + else + return Vt; + end if; + when Type_Unbounded_Array => + pragma Assert (Vtype.Kind = Type_Array); + return Vt; + when Type_Unbounded_Vector => + pragma Assert (Vtype.Kind = Type_Vector + or else Vtype.Kind = Type_Slice); + return Vt; + when Type_Record => + pragma Assert (Vtype.Kind = Type_Record); + -- TODO: handle elements. + return Vt; + when Type_Unbounded_Record => + pragma Assert (Vtype.Kind = Type_Record); + return Vt; + when Type_Access => + return Vt; + when Type_File + | Type_Protected => + -- No conversion expected. + -- As the subtype is identical, it is already handled by the + -- above check. + raise Internal_Error; + end case; + end Synth_Subtype_Conversion; + + function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp + is + Param : constant Node := Get_Parameter (Attr); + Etype : constant Node := Get_Type (Attr); + Btype : constant Node := Get_Base_Type (Etype); + V : Valtyp; + Dtype : Type_Acc; + begin + -- The value is supposed to be static. + V := Synth_Expression (Syn_Inst, Param); + if V = No_Valtyp then + return No_Valtyp; + end if; + + Dtype := Get_Subtype_Object (Syn_Inst, Etype); + if not Is_Static (V.Val) then + Error_Msg_Synth (+Attr, "parameter of 'value must be static"); + return No_Valtyp; + end if; + + declare + Str : constant String := Value_To_String (V); + Res_N : Node; + Val : Int64; + begin + case Get_Kind (Btype) is + when Iir_Kind_Enumeration_Type_Definition => + Res_N := Eval_Value_Attribute (Str, Etype, Attr); + Val := Int64 (Get_Enum_Pos (Res_N)); + Free_Iir (Res_N); + when Iir_Kind_Integer_Type_Definition => + Val := Int64'Value (Str); + when others => + Error_Msg_Synth (+Attr, "unhandled type for 'value"); + return No_Valtyp; + end case; + return Create_Value_Discrete (Val, Dtype); + end; + end Synth_Value_Attribute; + + function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir) + return String + is + use Grt.Types; + begin + case Get_Kind (Expr_Type) is + when Iir_Kind_Floating_Type_Definition + | Iir_Kind_Floating_Subtype_Definition => + declare + Str : String (1 .. 24); + Last : Natural; + begin + Grt.To_Strings.To_String + (Str, Last, Ghdl_F64 (Read_Fp64 (Val))); + return Str (Str'First .. Last); + end; + when Iir_Kind_Integer_Type_Definition + | Iir_Kind_Integer_Subtype_Definition => + declare + Str : String (1 .. 21); + First : Natural; + begin + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Val))); + return Str (First .. Str'Last); + end; + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + declare + Lits : constant Iir_Flist := + Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type)); + begin + return Name_Table.Image + (Get_Identifier + (Get_Nth_Element (Lits, Natural (Read_Discrete (Val))))); + end; + when Iir_Kind_Physical_Type_Definition + | Iir_Kind_Physical_Subtype_Definition => + declare + Str : String (1 .. 21); + First : Natural; + Id : constant Name_Id := + Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type))); + begin + Grt.To_Strings.To_String + (Str, First, Ghdl_I64 (Read_Discrete (Val))); + return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); + end; + when others => + Error_Kind ("execute_image_attribute", Expr_Type); + end case; + end Synth_Image_Attribute_Str; + + function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp + is + Len : constant Natural := Str'Length; + Bnd : Bound_Array_Acc; + Typ : Type_Acc; + Res : Valtyp; + begin + Bnd := Create_Bound_Array (1); + Bnd.D (1) := (Dir => Dir_To, Left => 1, Right => Int32 (Len), + Len => Width (Len)); + Typ := Create_Array_Type (Bnd, Styp.Uarr_El); + + Res := Create_Value_Memory (Typ); + for I in Str'Range loop + Write_U8 (Res.Val.Mem + Size_Type (I - Str'First), + Character'Pos (Str (I))); + end loop; + return Res; + end String_To_Valtyp; + + function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) + return Valtyp + is + Param : constant Node := Get_Parameter (Attr); + Etype : constant Node := Get_Type (Attr); + V : Valtyp; + Dtype : Type_Acc; + begin + -- The parameter is expected to be static. + V := Synth_Expression (Syn_Inst, Param); + if V = No_Valtyp then + return No_Valtyp; + end if; + Dtype := Get_Subtype_Object (Syn_Inst, Etype); + if not Is_Static (V.Val) then + Error_Msg_Synth (+Attr, "parameter of 'image must be static"); + return No_Valtyp; + end if; + + Strip_Const (V); + return String_To_Valtyp + (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype); + end Synth_Image_Attribute; + + function Synth_Instance_Name_Attribute + (Syn_Inst : Synth_Instance_Acc; Attr : Node) return Valtyp + is + Atype : constant Node := Get_Type (Attr); + Atyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); + Name : constant Path_Instance_Name_Type := + Get_Path_Instance_Name_Suffix (Attr); + begin + -- Return a truncated name, as the prefix is not completly known. + return String_To_Valtyp (Name.Suffix, Atyp); + end Synth_Instance_Name_Attribute; + + function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) + return Valtyp is + begin + case Get_Kind (Name) is + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name => + return Synth_Name (Syn_Inst, Get_Named_Entity (Name)); + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Constant_Declaration + | Iir_Kind_Iterator_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Interface_File_Declaration => + return Get_Value (Syn_Inst, Name); + when Iir_Kind_Enumeration_Literal => + declare + Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Name)); + Res : Valtyp; + begin + Res := Create_Value_Memory (Typ); + Write_Discrete (Res, Int64 (Get_Enum_Pos (Name))); + return Res; + end; + when Iir_Kind_Unit_Declaration => + declare + Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Name)); + begin + return Create_Value_Discrete + (Vhdl.Evaluation.Get_Physical_Value (Name), Typ); + end; + when Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + declare + Val : Valtyp; + begin + Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); + return Vhdl_Heap.Synth_Dereference (Read_Access (Val)); + end; + when others => + Error_Kind ("synth_name", Name); + end case; + end Synth_Name; + + -- Convert index IDX in PFX to an offset. + -- SYN_INST and LOC are used in case of error. + function Index_To_Offset + (Syn_Inst : Synth_Instance_Acc; Bnd : Bound_Type; Idx : Int64; Loc : Node) + return Value_Offsets + is + Res : Value_Offsets; + begin + if not In_Bounds (Bnd, Int32 (Idx)) then + Error_Msg_Synth (+Loc, "index not within bounds"); + Synth.Debugger.Debug_Error (Syn_Inst, Loc); + return (0, 0); + end if; + + -- The offset is from the LSB (bit 0). Bit 0 is the rightmost one. + case Bnd.Dir is + when Dir_To => + Res.Net_Off := Uns32 (Bnd.Right - Int32 (Idx)); + Res.Mem_Off := Size_Type (Int32 (Idx) - Bnd.Left); + when Dir_Downto => + Res.Net_Off := Uns32 (Int32 (Idx) - Bnd.Right); + Res.Mem_Off := Size_Type (Bnd.Left - Int32 (Idx)); + end case; + + return Res; + end Index_To_Offset; + + function Dyn_Index_To_Offset + (Ctxt : Context_Acc; Bnd : Bound_Type; Idx_Val : Valtyp; Loc : Node) + return Net + is + Idx2 : Net; + Off : Net; + Right : Net; + Wbounds : Width; + begin + Wbounds := Clog2 (Bnd.Len); + Idx2 := Synth_Resize (Ctxt, Idx_Val, Wbounds, Loc); + + if Bnd.Right = 0 and then Bnd.Dir = Dir_Downto then + -- Simple case without adjustments. + return Idx2; + end if; + + Right := Build_Const_UB32 (Ctxt, To_Uns32 (Bnd.Right), Wbounds); + Set_Location (Right, Loc); + + case Bnd.Dir is + when Dir_To => + -- L <= I <= R --> off = R - I + Off := Build_Dyadic (Ctxt, Id_Sub, Right, Idx2); + when Dir_Downto => + -- L >= I >= R --> off = I - R + Off := Build_Dyadic (Ctxt, Id_Sub, Idx2, Right); + end case; + Set_Location (Off, Loc); + return Off; + end Dyn_Index_To_Offset; + + -- Return the bounds of a one dimensional array/vector type and the + -- width of the element. + procedure Get_Onedimensional_Array_Bounds + (Typ : Type_Acc; Bnd : out Bound_Type; El_Typ : out Type_Acc) is + begin + case Typ.Kind is + when Type_Vector => + El_Typ := Typ.Vec_El; + Bnd := Typ.Vbound; + when Type_Array => + El_Typ := Typ.Arr_El; + Bnd := Typ.Abounds.D (1); + when others => + raise Internal_Error; + end case; + end Get_Onedimensional_Array_Bounds; + + function Create_Onedimensional_Array_Subtype + (Btyp : Type_Acc; Bnd : Bound_Type) return Type_Acc + is + Res : Type_Acc; + Bnds : Bound_Array_Acc; + begin + case Btyp.Kind is + when Type_Vector => + Res := Create_Vector_Type (Bnd, Btyp.Vec_El); + when Type_Unbounded_Vector => + Res := Create_Vector_Type (Bnd, Btyp.Uvec_El); + when Type_Array => + pragma Assert (Btyp.Abounds.Ndim = 1); + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res := Create_Array_Type (Bnds, Btyp.Arr_El); + when Type_Unbounded_Array => + pragma Assert (Btyp.Uarr_Ndim = 1); + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bnd; + Res := Create_Array_Type (Bnds, Btyp.Uarr_El); + when others => + raise Internal_Error; + end case; + return Res; + end Create_Onedimensional_Array_Subtype; + + procedure Synth_Indexed_Name (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Type : Type_Acc; + Voff : out Net; + Off : out Value_Offsets) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Indexes : constant Iir_Flist := Get_Index_List (Name); + El_Typ : constant Type_Acc := Get_Array_Element (Pfx_Type); + Idx_Expr : Node; + Idx_Val : Valtyp; + Bnd : Bound_Type; + Stride : Uns32; + Ivoff : Net; + Idx_Off : Value_Offsets; + begin + Voff := No_Net; + Off := (0, 0); + + Stride := 1; + for I in reverse Flist_First .. Flist_Last (Indexes) loop + Idx_Expr := Get_Nth_Element (Indexes, I); + + -- Use the base type as the subtype of the index is not synth-ed. + Idx_Val := Synth_Expression_With_Basetype (Syn_Inst, Idx_Expr); + if Idx_Val = No_Valtyp then + -- Propagate errorc + Voff := No_Net; + Off := (0, 0); + return; + end if; + + Strip_Const (Idx_Val); + + Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1)); + + if Is_Static_Val (Idx_Val.Val) then + Idx_Off := Index_To_Offset (Syn_Inst, Bnd, + Get_Static_Discrete (Idx_Val), Name); + Off.Net_Off := Off.Net_Off + Idx_Off.Net_Off * Stride * El_Typ.W; + Off.Mem_Off := Off.Mem_Off + + Idx_Off.Mem_Off * Size_Type (Stride) * El_Typ.Sz; + else + Ivoff := Dyn_Index_To_Offset (Ctxt, Bnd, Idx_Val, Name); + Ivoff := Build_Memidx + (Get_Build (Syn_Inst), Ivoff, El_Typ.W * Stride, + Bnd.Len - 1, + Width (Clog2 (Uns64 (Stride * Bnd.Len)))); + Set_Location (Ivoff, Idx_Expr); + + if Voff = No_Net then + Voff := Ivoff; + else + Voff := Build_Addidx (Get_Build (Syn_Inst), Ivoff, Voff); + Set_Location (Voff, Idx_Expr); + end if; + end if; + + Stride := Stride * Bnd.Len; + end loop; + end Synth_Indexed_Name; + + function Is_Static (N : Net) return Boolean is + begin + case Get_Id (Get_Module (Get_Net_Parent (N))) is + when Id_Const_UB32 => + return True; + when others => + return False; + end case; + end Is_Static; + + function Get_Const (N : Net) return Int32 + is + Inst : constant Instance := Get_Net_Parent (N); + begin + case Get_Id (Get_Module (Inst)) is + when Id_Const_UB32 => + return To_Int32 (Get_Param_Uns32 (Inst, 0)); + when others => + raise Internal_Error; + end case; + end Get_Const; + + -- Decompose VAL as FACTOR * INP + ADDEND (where only INP is non-static). + procedure Decompose_Mul_Add (Val : Net; + Inp : out Net; + Factor : out Int32; + Addend : out Int32) + is + Inst : Instance; + Val_I0, Val_I1 : Net; + begin + Factor := 1; + Addend := 0; + Inp := Val; + + loop + Inst := Get_Net_Parent (Inp); + case Get_Id (Get_Module (Inst)) is + when Id_Add => + Val_I0 := Get_Input_Net (Inst, 0); + Val_I1 := Get_Input_Net (Inst, 1); + if Is_Static (Val_I0) then + Addend := Addend + Get_Const (Val_I0) * Factor; + Inp := Val_I1; + elsif Is_Static (Val_I1) then + Addend := Addend + Get_Const (Val_I1) * Factor; + Inp := Val_I0; + else + -- It's an addition, but without any constant value. + return; + end if; + when Id_Sub => + Val_I0 := Get_Input_Net (Inst, 0); + Val_I1 := Get_Input_Net (Inst, 1); + if Is_Static (Val_I1) then + Addend := Addend - Get_Const (Val_I1) * Factor; + Inp := Val_I0; + elsif Is_Static (Val_I0) then + Addend := Addend + Get_Const (Val_I0) * Factor; + Factor := -Factor; + Inp := Val_I1; + else + -- It's a substraction, but without any constant value. + return; + end if; + when Id_Smul => + Val_I0 := Get_Input_Net (Inst, 0); + Val_I1 := Get_Input_Net (Inst, 1); + if Is_Static (Val_I0) then + Factor := Factor * Get_Const (Val_I0); + Inp := Val_I1; + elsif Is_Static (Val_I1) then + Factor := Factor * Get_Const (Val_I1); + Inp := Val_I0; + else + -- A mul but without any constant value. + return; + end if; + when Id_Utrunc + | Id_Uextend => + Inp := Get_Input_Net (Inst, 0); + when others => + -- Cannot decompose it. + return; + end case; + end loop; + end Decompose_Mul_Add; + + -- Identify LEFT to/downto RIGHT as: + -- INP * STEP + WIDTH - 1 + OFF to/downto INP * STEP + OFF + procedure Synth_Extract_Dyn_Suffix (Ctxt : Context_Acc; + Loc : Node; + Pfx_Bnd : Bound_Type; + Left : Net; + Right : Net; + Inp : out Net; + Step : out Uns32; + Off : out Uns32; + Width : out Uns32) + is + L_Inp, R_Inp : Net; + L_Fac, R_Fac : Int32; + L_Add, R_Add : Int32; + begin + Inp := No_Net; + Step := 0; + Off := 0; + Width := 0; + + if Left = Right then + L_Inp := Left; + R_Inp := Right; + L_Fac := 1; + R_Fac := 1; + L_Add := 0; + R_Add := 0; + else + Decompose_Mul_Add (Left, L_Inp, L_Fac, L_Add); + Decompose_Mul_Add (Right, R_Inp, R_Fac, R_Add); + end if; + + if not Same_Net (L_Inp, R_Inp) then + Error_Msg_Synth + (+Loc, "cannot extract same variable part for dynamic slice"); + return; + end if; + Inp := L_Inp; + + if L_Fac /= R_Fac then + Error_Msg_Synth + (+Loc, "cannot extract same constant factor for dynamic slice"); + return; + end if; + if L_Fac < 0 then + Step := Uns32 (-L_Fac); + Inp := Build_Monadic (Ctxt, Id_Neg, Inp); + Set_Location (Inp, Loc); + else + Step := Uns32 (L_Fac); + end if; + + case Pfx_Bnd.Dir is + when Dir_To => + Width := Uns32 (R_Add - L_Add + 1); + Off := Uns32 (L_Add - Pfx_Bnd.Left); + when Dir_Downto => + Width := Uns32 (L_Add - R_Add + 1); + if R_Add >= Pfx_Bnd.Right then + Off := Uns32 (R_Add - Pfx_Bnd.Right); + else + -- Handle biased values. + declare + Bias : constant Uns32 := + (Uns32 (Pfx_Bnd.Right - R_Add) + Step - 1) / Step; + Bias_Net : Net; + begin + -- Add bias to INP and adjust the offset. + Bias_Net := Build2_Const_Uns + (Ctxt, Uns64 (Bias), Get_Width (Inp)); + Inp := Build_Dyadic (Ctxt, Id_Add, Inp, Bias_Net); + Set_Location (Inp, Loc); + Off := Uns32 (Int32 (Bias * Step) + R_Add - Pfx_Bnd.Right); + end; + end if; + end case; + end Synth_Extract_Dyn_Suffix; + + procedure Synth_Slice_Const_Suffix (Syn_Inst: Synth_Instance_Acc; + Expr : Node; + Name : Node; + Pfx_Bnd : Bound_Type; + L, R : Int64; + Dir : Direction_Type; + El_Typ : Type_Acc; + Res_Bnd : out Bound_Type; + Off : out Value_Offsets) + is + Is_Null : Boolean; + Len : Uns32; + begin + if Pfx_Bnd.Dir /= Dir then + Error_Msg_Synth (+Name, "direction mismatch in slice"); + Off := (0, 0); + if Dir = Dir_To then + Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); + else + Res_Bnd := (Dir => Dir_Downto, Left => 0, Right => 1, Len => 0); + end if; + return; + end if; + + -- Might be a null slice. + case Pfx_Bnd.Dir is + when Dir_To => + Is_Null := L > R; + when Dir_Downto => + Is_Null := L < R; + end case; + if Is_Null then + Len := 0; + Off := (0, 0); + else + if not In_Bounds (Pfx_Bnd, Int32 (L)) + or else not In_Bounds (Pfx_Bnd, Int32 (R)) + then + Error_Msg_Synth (+Name, "index not within bounds"); + Synth.Debugger.Debug_Error (Syn_Inst, Expr); + Off := (0, 0); + return; + end if; + + case Pfx_Bnd.Dir is + when Dir_To => + Len := Uns32 (R - L + 1); + Off.Net_Off := Uns32 (Pfx_Bnd.Right - Int32 (R)) * El_Typ.W; + Off.Mem_Off := Size_Type (Int32 (L) - Pfx_Bnd.Left) * El_Typ.Sz; + when Dir_Downto => + Len := Uns32 (L - R + 1); + Off.Net_Off := Uns32 (Int32 (R) - Pfx_Bnd.Right) * El_Typ.W; + Off.Mem_Off := Size_Type (Pfx_Bnd.Left - Int32 (L)) * El_Typ.Sz; + end case; + end if; + Res_Bnd := (Dir => Pfx_Bnd.Dir, + Len => Len, + Left => Int32 (L), + Right => Int32 (R)); + end Synth_Slice_Const_Suffix; + + procedure Synth_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; + Name : Node; + Pfx_Bnd : Bound_Type; + El_Typ : Type_Acc; + Res_Bnd : out Bound_Type; + Inp : out Net; + Off : out Value_Offsets) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Expr : constant Node := Get_Suffix (Name); + Left, Right : Valtyp; + Dir : Direction_Type; + Step : Uns32; + Max : Uns32; + Inp_W : Width; + begin + Off := (0, 0); + Inp := No_Net; + + case Get_Kind (Expr) is + when Iir_Kind_Range_Expression => + -- As the range may be dynamic, cannot use synth_discrete_range. + Left := Synth_Expression_With_Basetype + (Syn_Inst, Get_Left_Limit (Expr)); + Right := Synth_Expression_With_Basetype + (Syn_Inst, Get_Right_Limit (Expr)); + Dir := Get_Direction (Expr); + + when Iir_Kind_Range_Array_Attribute + | Iir_Kind_Reverse_Range_Array_Attribute + | Iir_Kinds_Denoting_Name => + declare + Rng : Discrete_Range_Type; + begin + Synth_Discrete_Range (Syn_Inst, Expr, Rng); + Synth_Slice_Const_Suffix (Syn_Inst, Expr, + Name, Pfx_Bnd, + Rng.Left, Rng.Right, Rng.Dir, + El_Typ, Res_Bnd, Off); + return; + end; + when others => + Error_Msg_Synth + (+Expr, "only range expression supported for slices"); + Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); + return; + end case; + + if Is_Static_Val (Left.Val) and then Is_Static_Val (Right.Val) then + Synth_Slice_Const_Suffix (Syn_Inst, Expr, + Name, Pfx_Bnd, + Get_Static_Discrete (Left), + Get_Static_Discrete (Right), + Dir, + El_Typ, Res_Bnd, Off); + else + if Pfx_Bnd.Dir /= Dir then + Error_Msg_Synth (+Name, "direction mismatch in slice"); + if Dir = Dir_To then + Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); + else + Res_Bnd := (Dir => Dir_Downto, Left => 0, Right => 1, Len => 0); + end if; + return; + end if; + + if Is_Static (Left.Val) or else Is_Static (Right.Val) then + Error_Msg_Synth + (+Name, "left and right bounds of a slice must be " + & "either constant or dynamic"); + return; + end if; + + Synth_Extract_Dyn_Suffix + (Ctxt, Name, Pfx_Bnd, Get_Net (Ctxt, Left), Get_Net (Ctxt, Right), + Inp, Step, Off.Net_Off, Res_Bnd.Len); + if Inp = No_Net then + return; + end if; + Inp_W := Get_Width (Inp); + -- FIXME: convert range to offset. + -- Extract max from the range. + -- example: len=128 wd=8 step=8 => max=16 + -- len=8 wd=4 step=1 => max=4 + -- max so that max*step+wd <= len - off + -- max <= (len - off - wd) / step + Max := (Pfx_Bnd.Len - Off.Net_Off - Res_Bnd.Len) / Step; + if Clog2 (Uns64 (Max)) > Natural (Inp_W) then + -- The width of Inp limits the max. + Max := 2**Natural (Inp_W) - 1; + end if; + Inp := Build_Memidx + (Ctxt, Inp, Step * El_Typ.W, Max, + Inp_W + Width (Clog2 (Uns64 (Step * El_Typ.W)))); + Set_Location (Inp, Name); + end if; + end Synth_Slice_Suffix; + + -- Match: clk_signal_name'event + -- and return clk_signal_name. + function Extract_Event_Expr_Prefix (Expr : Node) return Node is + begin + if Get_Kind (Expr) = Iir_Kind_Event_Attribute then + return Get_Prefix (Expr); + else + return Null_Node; + end if; + end Extract_Event_Expr_Prefix; + + function Is_Same_Clock (Syn_Inst : Synth_Instance_Acc; + Left, Right : Node; + Clk_Left : Net) return Boolean + is + N : Net; + begin + -- Handle directly the common case (when clock is a simple name). + if Get_Kind (Left) = Iir_Kind_Simple_Name + and then Get_Kind (Right) = Iir_Kind_Simple_Name + then + return Get_Named_Entity (Left) = Get_Named_Entity (Right); + end if; + + N := Get_Net (Get_Build (Syn_Inst), Synth_Expression (Syn_Inst, Right)); + + return Same_Net (Clk_Left, N); + end Is_Same_Clock; + + -- Match: clk_signal_name = '1' | clk_signal_name = '0' + function Extract_Clock_Level + (Syn_Inst : Synth_Instance_Acc; Expr : Node; Prefix : Node) return Net + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Clk : Net; + Imp : Node; + Left, Right : Node; + Lit : Valtyp; + Lit_Type : Node; + Posedge : Boolean; + Res : Net; + begin + Clk := Get_Net (Ctxt, Synth_Expression (Syn_Inst, Prefix)); + if Get_Kind (Expr) /= Iir_Kind_Equality_Operator then + Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected"); + Res := Build_Posedge (Ctxt, Clk); + Set_Location (Res, Expr); + return Res; + end if; + Imp := Get_Implementation (Expr); + if Get_Implicit_Definition (Imp) /= Iir_Predefined_Enum_Equality then + Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected"); + Res := Build_Posedge (Ctxt, Clk); + Set_Location (Res, Expr); + return Res; + end if; + + Left := Get_Left (Expr); + if not Is_Same_Clock (Syn_Inst, Prefix, Left, Clk) then + Error_Msg_Synth (+Left, "clock signal name doesn't match"); + end if; + + Right := Get_Right (Expr); + Lit_Type := Get_Base_Type (Get_Type (Right)); + Lit := Synth_Expression (Syn_Inst, Right); + if Lit.Val.Kind /= Value_Memory then + Error_Msg_Synth (+Right, "clock-level is not a constant"); + Posedge := True; + else + if Lit_Type = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type then + case Read_U8 (Lit.Val.Mem) is + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_0_Pos => + Posedge := False; + when Vhdl.Ieee.Std_Logic_1164.Std_Logic_1_Pos => + Posedge := True; + when others => + Error_Msg_Synth + (+Right, "clock-level must be either '0' or '1'"); + Posedge := True; + end case; + else + pragma Assert (Lit_Type = Vhdl.Std_Package.Bit_Type_Definition); + case Read_U8 (Lit.Val.Mem) is + when 0 => + Posedge := False; + when 1 => + Posedge := True; + when others => + raise Internal_Error; + end case; + end if; + end if; + if Posedge then + Res := Build_Posedge (Ctxt, Clk); + else + Res := Build_Negedge (Ctxt, Clk); + end if; + Set_Location (Res, Expr); + return Res; + end Extract_Clock_Level; + + -- Try to match: clk'event and clk = X + -- or: clk = X and clk'event + -- where X is '0' or '1'. + function Synth_Clock_Edge + (Syn_Inst : Synth_Instance_Acc; Left, Right : Node) return Net + is + Prefix : Node; + begin + -- Try with left. + Prefix := Extract_Event_Expr_Prefix (Left); + if Is_Valid (Prefix) then + return Extract_Clock_Level (Syn_Inst, Right, Prefix); + end if; + + -- Try with right. + Prefix := Extract_Event_Expr_Prefix (Right); + if Is_Valid (Prefix) then + return Extract_Clock_Level (Syn_Inst, Left, Prefix); + end if; + + return No_Net; + end Synth_Clock_Edge; + + function Synth_Type_Conversion + (Syn_Inst : Synth_Instance_Acc; Conv : Node) return Valtyp + is + Expr : constant Node := Get_Expression (Conv); + Conv_Type : constant Node := Get_Type (Conv); + Conv_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Conv_Type); + Val : Valtyp; + begin + Val := Synth_Expression_With_Basetype (Syn_Inst, Expr); + if Val = No_Valtyp then + return No_Valtyp; + end if; + Strip_Const (Val); + case Get_Kind (Conv_Type) is + when Iir_Kind_Integer_Subtype_Definition => + if Val.Typ.Kind = Type_Discrete then + -- Int to int. + return Val; + elsif Val.Typ.Kind = Type_Float then + return Create_Value_Discrete + (Int64 (Read_Fp64 (Val)), Conv_Typ); + else + Error_Msg_Synth (+Conv, "unhandled type conversion (to int)"); + return No_Valtyp; + end if; + when Iir_Kind_Floating_Subtype_Definition => + if Is_Static (Val.Val) then + return Create_Value_Float + (Fp64 (Read_Discrete (Val)), Conv_Typ); + else + Error_Msg_Synth (+Conv, "unhandled type conversion (to float)"); + return No_Valtyp; + end if; + when Iir_Kind_Array_Type_Definition + | Iir_Kind_Array_Subtype_Definition => + case Conv_Typ.Kind is + when Type_Vector + | Type_Unbounded_Vector => + return Val; + when others => + Error_Msg_Synth + (+Conv, "unhandled type conversion (to array)"); + return No_Valtyp; + end case; + when Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition => + pragma Assert (Get_Base_Type (Get_Type (Expr)) + = Get_Base_Type (Conv_Type)); + return Val; + when others => + Error_Msg_Synth (+Conv, "unhandled type conversion"); + return No_Valtyp; + end case; + end Synth_Type_Conversion; + + function Error_Ieee_Operator (Imp : Node; Loc : Node) return Boolean + is + use Std_Names; + Parent : constant Iir := Get_Parent (Imp); + begin + if Get_Kind (Parent) = Iir_Kind_Package_Declaration + and then (Get_Identifier + (Get_Library (Get_Design_File (Get_Design_Unit (Parent)))) + = Name_Ieee) + then + case Get_Identifier (Parent) is + when Name_Std_Logic_1164 + | Name_Std_Logic_Arith + | Name_Std_Logic_Signed + | Name_Std_Logic_Unsigned + | Name_Std_Logic_Misc + | Name_Numeric_Std + | Name_Numeric_Bit + | Name_Math_Real => + Error_Msg_Synth + (+Loc, "unhandled predefined IEEE operator %i", +Imp); + Error_Msg_Synth + (+Imp, " declared here"); + return True; + when others => + -- ieee 2008 packages are handled like regular packages. + null; + end case; + end if; + + return False; + end Error_Ieee_Operator; + + function Synth_String_Literal + (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) + return Valtyp + is + pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); + Id : constant String8_Id := Get_String8_Id (Str); + + Str_Type : constant Node := Get_Type (Str); + El_Type : Type_Acc; + Bounds : Bound_Type; + Bnds : Bound_Array_Acc; + Res_Type : Type_Acc; + Res : Valtyp; + Pos : Nat8; + begin + case Str_Typ.Kind is + when Type_Vector => + Bounds := Str_Typ.Vbound; + when Type_Array => + Bounds := Str_Typ.Abounds.D (1); + when Type_Unbounded_Vector + | Type_Unbounded_Array => + Bounds := Synth_Bounds_From_Length + (Get_Index_Type (Str_Type, 0), Get_String_Length (Str)); + when others => + raise Internal_Error; + end case; + + El_Type := Get_Subtype_Object (Syn_Inst, Get_Element_Subtype (Str_Type)); + if El_Type.Kind in Type_Nets then + Res_Type := Create_Vector_Type (Bounds, El_Type); + else + Bnds := Create_Bound_Array (1); + Bnds.D (1) := Bounds; + Res_Type := Create_Array_Type (Bnds, El_Type); + end if; + Res := Create_Value_Memory (Res_Type); + + -- Only U8 are handled. + pragma Assert (El_Type.Sz = 1); + + -- From left to right. + for I in 1 .. Bounds.Len loop + -- FIXME: use literal from type ?? + Pos := Str_Table.Element_String8 (Id, Pos32 (I)); + Write_U8 (Res.Val.Mem + Size_Type (I - 1), Nat8'Pos (Pos)); + end loop; + + return Res; + end Synth_String_Literal; + + -- Return the left bound if the direction of the range is LEFT_DIR. + function Synth_Low_High_Type_Attribute + (Syn_Inst : Synth_Instance_Acc; Expr : Node; Left_Dir : Direction_Type) + return Valtyp + is + Typ : Type_Acc; + R : Int64; + begin + Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Get_Prefix (Expr))); + pragma Assert (Typ.Kind = Type_Discrete); + if Typ.Drange.Dir = Left_Dir then + R := Typ.Drange.Left; + else + R := Typ.Drange.Right; + end if; + return Create_Value_Discrete (R, Typ); + end Synth_Low_High_Type_Attribute; + + function Synth_PSL_Expression + (Syn_Inst : Synth_Instance_Acc; Expr : PSL.Types.PSL_Node) return Net + is + use PSL.Types; + use PSL.Nodes; + + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Loc : constant Location_Type := Get_Location (Expr); + Res : Net; + begin + case Get_Kind (Expr) is + when N_HDL_Bool => + declare + E : constant Vhdl.Types.Vhdl_Node := Get_HDL_Node (Expr); + begin + return Get_Net (Ctxt, Synth_Expression (Syn_Inst, E)); + end; + when N_Not_Bool => + pragma Assert (Loc /= No_Location); + Res := Build_Monadic + (Ctxt, Id_Not, + Synth_PSL_Expression (Syn_Inst, Get_Boolean (Expr))); + when N_And_Bool => + pragma Assert (Loc /= No_Location); + declare + L : constant PSL_Node := Get_Left (Expr); + R : constant PSL_Node := Get_Right (Expr); + Edge : Net; + begin + -- Handle edge (as it can be in default clock). + if Get_Kind (L) in N_HDLs and then Get_Kind (R) in N_HDLs then + Edge := Synth_Clock_Edge + (Syn_Inst, Get_HDL_Node (L), Get_HDL_Node (R)); + if Edge /= No_Net then + return Edge; + end if; + end if; + if Get_Kind (R) = N_EOS then + -- It is never EOS! + Res := Build_Const_UB32 (Ctxt, 0, 1); + else + Res := Build_Dyadic (Ctxt, Id_And, + Synth_PSL_Expression (Syn_Inst, L), + Synth_PSL_Expression (Syn_Inst, R)); + end if; + end; + when N_Or_Bool => + pragma Assert (Loc /= No_Location); + Res := Build_Dyadic + (Ctxt, Id_Or, + Synth_PSL_Expression (Syn_Inst, Get_Left (Expr)), + Synth_PSL_Expression (Syn_Inst, Get_Right (Expr))); + when N_True => + Res := Build_Const_UB32 (Ctxt, 1, 1); + when N_False + | N_EOS => + Res := Build_Const_UB32 (Ctxt, 0, 1); + when others => + PSL.Errors.Error_Kind ("synth_psl_expr", Expr); + return No_Net; + end case; + Netlists.Locations.Set_Location (Get_Net_Parent (Res), Loc); + return Res; + end Synth_PSL_Expression; + + function Synth_Psl_Function_Clock + (Syn_Inst : Synth_Instance_Acc; Call : Node; Ctxt : Context_Acc) + return Net + is + Clock : Node; + Clk : Valtyp; + Clk_Net : Net; + begin + Clock := Get_Clock_Expression (Call); + if Clock /= Null_Node then + Clk := Synth_Expression (Syn_Inst, Clock); + Clk_Net := Get_Net (Ctxt, Clk); + else + Clock := Get_Default_Clock (Call); + pragma Assert (Clock /= Null_Node); + Clk_Net := Synth_PSL_Expression (Syn_Inst, Get_Psl_Boolean (Clock)); + end if; + return Clk_Net; + end Synth_Psl_Function_Clock; + + function Synth_Psl_Prev (Syn_Inst : Synth_Instance_Acc; Call : Node) + return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Count : constant Node := Get_Count_Expression (Call); + Count_Val : Valtyp; + Dff : Net; + Expr : Valtyp; + Clk_Net : Net; + Num : Int64; + begin + Expr := Synth_Expression_With_Basetype (Syn_Inst, Get_Expression (Call)); + + Clk_Net := Synth_Psl_Function_Clock (Syn_Inst, Call, Ctxt); + + if Count /= Null_Node then + Count_Val := Synth_Expression (Syn_Inst, Count); + Num := Read_Discrete (Count_Val); + pragma Assert (Num >= 1); + else + Num := 1; + end if; + + Dff := Get_Net (Ctxt, Expr); + for I in 1 .. Num loop + Dff := Build_Dff (Ctxt, Clk_Net, Dff); + Set_Location (Dff, Call); + end loop; + + return Create_Value_Net (Dff, Expr.Typ); + end Synth_Psl_Prev; + + function Synth_Psl_Stable (Syn_Inst : Synth_Instance_Acc; Call : Node) + return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + DffCurr : Net; + Dff : Net; + Expr : Valtyp; + Clk_Net : Net; + Res : Net; + begin + Expr := Synth_Expression_With_Basetype (Syn_Inst, Get_Expression (Call)); + + Clk_Net := Synth_Psl_Function_Clock (Syn_Inst, Call, Ctxt); + + DffCurr := Get_Net (Ctxt, Expr); + Set_Location (DffCurr, Call); + Dff := Build_Dff (Ctxt, Clk_Net, DffCurr); + Set_Location (Dff, Call); + + Res := Build_Compare(Ctxt, Id_Eq, DffCurr, Dff); + Set_Location (Res, Call); + + return Create_Value_Net (Res, Boolean_Type); + + end Synth_Psl_Stable; + + function Synth_Psl_Rose (Syn_Inst : Synth_Instance_Acc; Call : Node) + return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + DffCurr : Net; + Dff : Net; + NotDff : Net; + Clk_Net : Net; + Expr : Valtyp; + Res : Net; + begin + Expr := Synth_Expression (Syn_Inst, Get_Expression (Call)); + + Clk_Net := Synth_Psl_Function_Clock (Syn_Inst, Call, Ctxt); + + DffCurr := Get_Net (Ctxt, Expr); + Set_Location (DffCurr, Call); + Dff := Build_Dff (Ctxt, Clk_Net, DffCurr); + Set_Location (Dff, Call); + + NotDff := Build_Monadic (Ctxt, Id_Not, Dff); + Set_Location (NotDff, Call); + + Res := Build_Dyadic (Ctxt, Id_And, + NotDff, DffCurr); + Set_Location (Res, Call); + + return Create_Value_Net (Res, Boolean_Type); + + end Synth_Psl_Rose; + + function Synth_Psl_Fell (Syn_Inst : Synth_Instance_Acc; Call : Node) + return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + DffCurr : Net; + NotDffCurr : Net; + Dff : Net; + Clk_Net : Net; + Expr : Valtyp; + Res : Net; + begin + Expr := Synth_Expression (Syn_Inst, Get_Expression (Call)); + + Clk_Net := Synth_Psl_Function_Clock(Syn_Inst, Call, Ctxt); + + DffCurr := Get_Net (Ctxt, Expr); + Set_Location (DffCurr, Call); + Dff := Build_Dff (Ctxt, Clk_Net, DffCurr); + Set_Location (Dff, Call); + + NotDffCurr := Build_Monadic (Ctxt, Id_Not, DffCurr); + Set_Location (NotDffCurr, Call); + + Res := Build_Dyadic (Ctxt, Id_And, Dff, NotDffCurr); + Set_Location (Res, Call); + + return Create_Value_Net (Res, Boolean_Type); + + end Synth_Psl_Fell; + + function Synth_Onehot0 (Ctxt : Context_Acc; DffCurr : Net; Call : Node; + Vlen : Uns32) + return Net + is + DffZero : Net; + DffOne : Net; + DffOneHot0 : Net; + Res : Net; + begin + -- Create a constant vector of 0 for comparing + DffZero := Build2_Const_Uns(Ctxt, 0, Vlen); + + -- Create vector of value 1 for subtraction + DffOne := Build2_Const_Uns(Ctxt, 1, Vlen); + + -- Subtraction -> v - 1 + DffOneHot0 := Build_Dyadic (Ctxt, Id_Sub, DffCurr, DffOne); + Set_Location (DffOneHot0, Call); + + -- Binary And -> v & (v - 1) + DffOneHot0 := Build_Dyadic (Ctxt, Id_And, DffCurr, DffOneHot0); + Set_Location (DffOneHot0, Call); + + -- Compare with 0 -> (v & (v - 1)) == 0 + Res := Build_Compare (Ctxt, Id_Eq, DffOneHot0, DffZero); + Set_Location (Res, Call); + + return Res; + end Synth_Onehot0; + + function Synth_Psl_Onehot (Syn_Inst : Synth_Instance_Acc; Call : Node) + return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Expr : Valtyp; + DffCurr : Net; + DffCurrIsNotZero : Net; + DffOneHot0 : Net; + Res : Net; + Vlen : Uns32; + begin + -- Get parameter & its length + Expr := Synth_Expression (Syn_Inst, Get_Expression (Call)); + Vlen := Expr.Typ.W; + + -- First get net of parameter + DffCurr := Get_Net (Ctxt, Expr); + Set_Location (DffCurr, Call); + + -- Compare parameter with 0 -> v != 0 + DffCurrIsNotZero := Build_Compare (Ctxt, Id_Ne, DffCurr, + Build2_Const_Uns(Ctxt, 0, Vlen)); + Set_Location (DffCurrIsNotZero, Call); + + -- Synth onehot0 + DffOneHot0 := Synth_Onehot0 (Ctxt, DffCurr, Call, Vlen); + Set_Location (DffOneHot0, Call); + + -- Final Binary And -> (v != 0) & ((v & (v - 1)) == 0) + Res := Build_Dyadic (Ctxt, Id_And, DffOneHot0, DffCurrIsNotZero); + Set_Location (Res, Call); + + return Create_Value_Net (Res, Boolean_Type); + end Synth_Psl_Onehot; + + function Synth_Psl_Onehot0 (Syn_Inst : Synth_Instance_Acc; Call : Node) + return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Expr : Valtyp; + Vlen : Uns32; + DffCurr : Net; + Res : Net; + begin + -- Get parameter & its length + Expr := Synth_Expression (Syn_Inst, Get_Expression (Call)); + Vlen := Expr.Typ.W; + + -- First get net of parameter + DffCurr := Get_Net (Ctxt, Expr); + Set_Location (DffCurr, Call); + + -- Synth onehot0 + Res := Synth_Onehot0 (Ctxt, DffCurr, Call, Vlen); + + return Create_Value_Net (Res, Boolean_Type); + end Synth_Psl_Onehot0; + + subtype And_Or_Module_Id is Module_Id range Id_And .. Id_Or; + + function Synth_Short_Circuit (Syn_Inst : Synth_Instance_Acc; + Id : And_Or_Module_Id; + Left_Expr : Node; + Right_Expr : Node; + Typ : Type_Acc; + Expr : Node) return Valtyp + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Left : Valtyp; + Right : Valtyp; + Val : Int64; + N : Net; + begin + -- The short-circuit value. + case Id is + when Id_And => + Val := 0; + when Id_Or => + Val := 1; + end case; + + Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Typ); + if Left = No_Valtyp then + -- Propagate error. + return No_Valtyp; + end if; + if Is_Static_Val (Left.Val) + and then Get_Static_Discrete (Left) = Val + then + -- Short-circuit when the left operand determines the result. + return Create_Value_Discrete (Val, Boolean_Type); + end if; + + Strip_Const (Left); + Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Typ); + if Right = No_Valtyp then + -- Propagate error. + return No_Valtyp; + end if; + Strip_Const (Right); + + if Is_Static_Val (Right.Val) + and then Get_Static_Discrete (Right) = Val + then + -- If the right operand can determine the result, return it. + return Create_Value_Discrete (Val, Boolean_Type); + end if; + + -- Return a static value if both operands are static. + -- Note: we know the value of left if it is not constant. + if Is_Static_Val (Left.Val) and then Is_Static_Val (Right.Val) then + Val := Get_Static_Discrete (Right); + return Create_Value_Discrete (Val, Boolean_Type); + end if; + + -- Non-static result. + N := Build_Dyadic (Ctxt, Id, + Get_Net (Ctxt, Left), Get_Net (Ctxt, Right)); + Set_Location (N, Expr); + return Create_Value_Net (N, Boolean_Type); + end Synth_Short_Circuit; + + function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; + Expr : Node; + Expr_Type : Type_Acc) return Valtyp is + begin + case Get_Kind (Expr) is + when Iir_Kinds_Dyadic_Operator => + declare + Imp : constant Node := Get_Implementation (Expr); + Def : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); + Edge : Net; + begin + -- Match clock-edge + if Def = Iir_Predefined_Boolean_And then + Edge := Synth_Clock_Edge (Syn_Inst, + Get_Left (Expr), Get_Right (Expr)); + if Edge /= No_Net then + return Create_Value_Net (Edge, Boolean_Type); + end if; + end if; + + -- Specially handle short-circuit operators. + case Def is + when Iir_Predefined_Boolean_And => + return Synth_Short_Circuit + (Syn_Inst, Id_And, Get_Left (Expr), Get_Right (Expr), + Boolean_Type, Expr); + when Iir_Predefined_Boolean_Or => + return Synth_Short_Circuit + (Syn_Inst, Id_Or, Get_Left (Expr), Get_Right (Expr), + Boolean_Type, Expr); + when Iir_Predefined_Bit_And => + return Synth_Short_Circuit + (Syn_Inst, Id_And, Get_Left (Expr), Get_Right (Expr), + Bit_Type, Expr); + when Iir_Predefined_Bit_Or => + return Synth_Short_Circuit + (Syn_Inst, Id_Or, Get_Left (Expr), Get_Right (Expr), + Bit_Type, Expr); + when Iir_Predefined_None => + if Error_Ieee_Operator (Imp, Expr) then + return No_Valtyp; + else + return Synth_User_Operator + (Syn_Inst, Get_Left (Expr), Get_Right (Expr), Expr); + end if; + when others => + return Synth_Dyadic_Operation + (Syn_Inst, Imp, + Get_Left (Expr), Get_Right (Expr), Expr); + end case; + end; + when Iir_Kinds_Monadic_Operator => + declare + Imp : constant Node := Get_Implementation (Expr); + Def : constant Iir_Predefined_Functions := + Get_Implicit_Definition (Imp); + begin + if Def = Iir_Predefined_None then + if Error_Ieee_Operator (Imp, Expr) then + return No_Valtyp; + else + return Synth_User_Operator + (Syn_Inst, Get_Operand (Expr), Null_Node, Expr); + end if; + else + return Synth_Monadic_Operation + (Syn_Inst, Imp, Get_Operand (Expr), Expr); + end if; + end; + when Iir_Kind_Simple_Name + | Iir_Kind_Selected_Name + | Iir_Kind_Interface_Signal_Declaration -- For PSL. + | Iir_Kind_Signal_Declaration -- For PSL. + | Iir_Kind_Implicit_Dereference + | Iir_Kind_Dereference => + declare + Res : Valtyp; + begin + Res := Synth_Name (Syn_Inst, Expr); + if Res.Typ.W = 0 and then Res.Val.Kind /= Value_Memory then + -- This is a null object. As nothing can be done about it, + -- returns 0. + return Create_Value_Memtyp (Create_Memory_Zero (Res.Typ)); + end if; + return Res; + end; + when Iir_Kind_Reference_Name => + -- Only used for anonymous signals in internal association. + return Synth_Expression_With_Type + (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); + when Iir_Kind_Anonymous_Signal_Declaration => + return Synth_Expression_With_Type + (Syn_Inst, Get_Expression (Expr), Expr_Type); + when Iir_Kind_Indexed_Name + | Iir_Kind_Slice_Name => + declare + Base : Valtyp; + Typ : Type_Acc; + Off : Value_Offsets; + Res : Valtyp; + + Dyn : Dyn_Name; + begin + Synth_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off, Dyn); + if Dyn.Voff = No_Net and then Is_Static (Base.Val) then + Res := Create_Value_Memory (Typ); + Copy_Memory + (Res.Val.Mem, Base.Val.Mem + Off.Mem_Off, Typ.Sz); + return Res; + end if; + return Synth_Read_Memory + (Syn_Inst, Base, Typ, Off.Net_Off, Dyn, Expr); + end; + when Iir_Kind_Selected_Element => + declare + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Idx : constant Iir_Index32 := + Get_Element_Position (Get_Named_Entity (Expr)); + Pfx : constant Node := Get_Prefix (Expr); + Res_Typ : Type_Acc; + N : Net; + Val : Valtyp; + Res : Valtyp; + begin + Val := Synth_Expression (Syn_Inst, Pfx); + Strip_Const (Val); + Res_Typ := Val.Typ.Rec.E (Idx + 1).Typ; + if Res_Typ.W = 0 and then Val.Val.Kind /= Value_Memory then + -- This is a null object. As nothing can be done about it, + -- returns 0. + return Create_Value_Memtyp (Create_Memory_Zero (Res_Typ)); + elsif Is_Static (Val.Val) then + Res := Create_Value_Memory (Res_Typ); + Copy_Memory + (Res.Val.Mem, Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Moff, + Res_Typ.Sz); + return Res; + else + N := Build_Extract + (Ctxt, Get_Net (Ctxt, Val), + Val.Typ.Rec.E (Idx + 1).Boff, Get_Type_Width (Res_Typ)); + Set_Location (N, Expr); + return Create_Value_Net (N, Res_Typ); + end if; + end; + when Iir_Kind_Character_Literal => + return Synth_Expression_With_Type + (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); + when Iir_Kind_Integer_Literal => + declare + Res : Valtyp; + begin + Res := Create_Value_Memory (Expr_Type); + Write_Discrete (Res, Get_Value (Expr)); + return Res; + end; + when Iir_Kind_Floating_Point_Literal => + return Create_Value_Float (Get_Fp_Value (Expr), Expr_Type); + when Iir_Kind_Physical_Int_Literal + | Iir_Kind_Physical_Fp_Literal => + return Create_Value_Discrete + (Get_Physical_Value (Expr), Expr_Type); + when Iir_Kind_String_Literal8 => + return Synth_String_Literal (Syn_Inst, Expr, Expr_Type); + when Iir_Kind_Enumeration_Literal => + return Synth_Name (Syn_Inst, Expr); + when Iir_Kind_Type_Conversion => + return Synth_Type_Conversion (Syn_Inst, Expr); + when Iir_Kind_Qualified_Expression => + return Synth_Expression_With_Type + (Syn_Inst, Get_Expression (Expr), + Get_Subtype_Object (Syn_Inst, Get_Type (Get_Type_Mark (Expr)))); + when Iir_Kind_Function_Call => + declare + Imp : constant Node := Get_Implementation (Expr); + begin + case Get_Implicit_Definition (Imp) is + when Iir_Predefined_Pure_Functions + | Iir_Predefined_Ieee_Numeric_Std_Binary_Operators => + return Synth_Operator_Function_Call (Syn_Inst, Expr); + when Iir_Predefined_None => + return Synth_User_Function_Call (Syn_Inst, Expr); + when others => + return Synth_Predefined_Function_Call (Syn_Inst, Expr); + end case; + end; + when Iir_Kind_Aggregate => + return Synth.Vhdl_Aggr.Synth_Aggregate (Syn_Inst, Expr, Expr_Type); + when Iir_Kind_Simple_Aggregate => + return Synth_Simple_Aggregate (Syn_Inst, Expr); + when Iir_Kind_Parenthesis_Expression => + return Synth_Expression_With_Type + (Syn_Inst, Get_Expression (Expr), Expr_Type); + when Iir_Kind_Left_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + return Create_Value_Discrete (Int64 (B.Left), Expr_Type); + end; + when Iir_Kind_Right_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + return Create_Value_Discrete (Int64 (B.Right), Expr_Type); + end; + when Iir_Kind_High_Array_Attribute => + declare + B : Bound_Type; + V : Int32; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + case B.Dir is + when Dir_To => + V := B.Right; + when Dir_Downto => + V := B.Left; + end case; + return Create_Value_Discrete (Int64 (V), Expr_Type); + end; + when Iir_Kind_Low_Array_Attribute => + declare + B : Bound_Type; + V : Int32; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + case B.Dir is + when Dir_To => + V := B.Left; + when Dir_Downto => + V := B.Right; + end case; + return Create_Value_Discrete (Int64 (V), Expr_Type); + end; + when Iir_Kind_Length_Array_Attribute => + declare + B : Bound_Type; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + return Create_Value_Discrete (Int64 (B.Len), Expr_Type); + end; + when Iir_Kind_Ascending_Array_Attribute => + declare + B : Bound_Type; + V : Int64; + begin + B := Synth_Array_Attribute (Syn_Inst, Expr); + case B.Dir is + when Dir_To => + V := 1; + when Dir_Downto => + V := 0; + end case; + return Create_Value_Discrete (V, Expr_Type); + end; + + when Iir_Kind_Pos_Attribute + | Iir_Kind_Val_Attribute => + declare + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Param : constant Node := Get_Parameter (Expr); + V : Valtyp; + Dtype : Type_Acc; + begin + V := Synth_Expression (Syn_Inst, Param); + Dtype := Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); + -- FIXME: to be generalized. Not always as simple as a + -- subtype conversion. + return Synth_Subtype_Conversion (Ctxt, V, Dtype, False, Expr); + end; + when Iir_Kind_Low_Type_Attribute => + return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_To); + when Iir_Kind_High_Type_Attribute => + return Synth_Low_High_Type_Attribute (Syn_Inst, Expr, Dir_Downto); + when Iir_Kind_Value_Attribute => + return Synth_Value_Attribute (Syn_Inst, Expr); + when Iir_Kind_Image_Attribute => + return Synth_Image_Attribute (Syn_Inst, Expr); + when Iir_Kind_Instance_Name_Attribute => + return Synth_Instance_Name_Attribute (Syn_Inst, Expr); + when Iir_Kind_Null_Literal => + return Create_Value_Access (Null_Heap_Index, Expr_Type); + when Iir_Kind_Allocator_By_Subtype => + declare + T : Type_Acc; + Acc : Heap_Index; + begin + T := Synth.Vhdl_Decls.Synth_Subtype_Indication + (Syn_Inst, Get_Subtype_Indication (Expr)); + Acc := Allocate_By_Type (T); + return Create_Value_Access (Acc, Expr_Type); + end; + when Iir_Kind_Allocator_By_Expression => + declare + V : Valtyp; + Acc : Heap_Index; + begin + V := Synth_Expression_With_Type + (Syn_Inst, Get_Expression (Expr), Expr_Type.Acc_Acc); + Acc := Allocate_By_Value (V); + return Create_Value_Access (Acc, Expr_Type); + end; + when Iir_Kind_Stable_Attribute => + Error_Msg_Synth (+Expr, "signal attribute not supported"); + return No_Valtyp; + when Iir_Kind_Psl_Prev => + return Synth_Psl_Prev (Syn_Inst, Expr); + when Iir_Kind_Psl_Stable => + return Synth_Psl_Stable (Syn_Inst, Expr); + when Iir_Kind_Psl_Rose => + return Synth_Psl_Rose(Syn_Inst, Expr); + when Iir_Kind_Psl_Fell => + return Synth_Psl_Fell(Syn_Inst, Expr); + when Iir_Kind_Psl_Onehot => + return Synth_Psl_Onehot(Syn_Inst, Expr); + when Iir_Kind_Psl_Onehot0 => + return Synth_Psl_Onehot0(Syn_Inst, Expr); + when Iir_Kind_Overflow_Literal => + Error_Msg_Synth (+Expr, "out of bound expression"); + return No_Valtyp; + when others => + Error_Kind ("synth_expression_with_type", Expr); + end case; + end Synth_Expression_With_Type; + + function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) + return Valtyp + is + Etype : Node; + begin + Etype := Get_Type (Expr); + + case Get_Kind (Expr) is + when Iir_Kind_High_Array_Attribute + | Iir_Kind_Low_Array_Attribute + | Iir_Kind_Integer_Literal => + -- The type of this attribute is the type of the index, which is + -- not synthesized as atype (only as an index). + -- For integer_literal, the type is not really needed, and it + -- may be created by static evaluation of an array attribute. + Etype := Get_Base_Type (Etype); + when others => + null; + end case; + + return Synth_Expression_With_Type + (Syn_Inst, Expr, Get_Subtype_Object (Syn_Inst, Etype)); + end Synth_Expression; + + function Synth_Expression_With_Basetype + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp + is + Basetype : Type_Acc; + begin + Basetype := Get_Subtype_Object + (Syn_Inst, Get_Base_Type (Get_Type (Expr))); + return Synth_Expression_With_Type (Syn_Inst, Expr, Basetype); + end Synth_Expression_With_Basetype; +end Synth.Vhdl_Expr; |