aboutsummaryrefslogtreecommitdiffstats
path: root/src/synth/synth-expr.adb
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2021-04-28 17:37:26 +0200
committerTristan Gingold <tgingold@free.fr>2021-04-28 17:37:26 +0200
commite3a82f2e6894155cc030680332f31db6f79aba28 (patch)
tree664593aa4fbb76c2f8c8a38d13d31b9335f99472 /src/synth/synth-expr.adb
parenta7334f5837fcc417173254707bc8acfc84120b47 (diff)
downloadghdl-e3a82f2e6894155cc030680332f31db6f79aba28.tar.gz
ghdl-e3a82f2e6894155cc030680332f31db6f79aba28.tar.bz2
ghdl-e3a82f2e6894155cc030680332f31db6f79aba28.zip
synth: file renaming for decls, expr, insts and stmts.
Diffstat (limited to 'src/synth/synth-expr.adb')
-rw-r--r--src/synth/synth-expr.adb2572
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;