diff options
Diffstat (limited to 'src/synth/synth-expr.adb')
-rw-r--r-- | src/synth/synth-expr.adb | 2572 |
1 files changed, 0 insertions, 2572 deletions
diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb deleted file mode 100644 index d05c0d089..000000000 --- a/src/synth/synth-expr.adb +++ /dev/null @@ -1,2572 +0,0 @@ --- 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.Decls; -with Synth.Stmts; use Synth.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.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.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.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.Expr; |