diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-08-19 07:20:25 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-08-19 07:46:47 +0200 |
commit | c28f780bc65b54989cccf83b0637113be3964b51 (patch) | |
tree | 2952b30cef115df0aaf6efa4c4122324043e8c12 /src/synth/elab-vhdl_expr.adb | |
parent | 8445d2e9d7af348c86d6e28eff74407530719138 (diff) | |
download | ghdl-c28f780bc65b54989cccf83b0637113be3964b51.tar.gz ghdl-c28f780bc65b54989cccf83b0637113be3964b51.tar.bz2 ghdl-c28f780bc65b54989cccf83b0637113be3964b51.zip |
elab-vhdl_expr: factorize code
Diffstat (limited to 'src/synth/elab-vhdl_expr.adb')
-rw-r--r-- | src/synth/elab-vhdl_expr.adb | 965 |
1 files changed, 15 insertions, 950 deletions
diff --git a/src/synth/elab-vhdl_expr.adb b/src/synth/elab-vhdl_expr.adb index f29ca1347..d1b44fe78 100644 --- a/src/synth/elab-vhdl_expr.adb +++ b/src/synth/elab-vhdl_expr.adb @@ -18,9 +18,9 @@ with Types; use Types; with Name_Table; -with Std_Names; with Str_Table; -with Errorout; use Errorout; + +with Netlists.Builders; with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; @@ -30,11 +30,7 @@ with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Heap; use Elab.Vhdl_Heap; with Elab.Vhdl_Types; use Elab.Vhdl_Types; with Elab.Vhdl_Errors; use Elab.Vhdl_Errors; -with Elab.Debugger; -with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; -with Synth.Vhdl_Oper; use Synth.Vhdl_Oper; -with Synth.Vhdl_Aggr; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Vhdl_Eval; use Synth.Vhdl_Eval; @@ -91,7 +87,7 @@ package body Elab.Vhdl_Expr is for I in Flist_First .. Last loop -- Elements are supposed to be static, so no need for enable. - Val := Exec_Expression_With_Type + 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); @@ -100,138 +96,13 @@ package body Elab.Vhdl_Expr is return Res; end Exec_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_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 Exec_Subtype_Conversion (Vt : Valtyp; Dtype : Type_Acc; Bounds : Boolean; - Loc : Node) - return Valtyp - is - Vtype : constant Type_Acc := Vt.Typ; + Loc : Node) return Valtyp is 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 => - raise Internal_Error; - when Value_Const => - return Exec_Subtype_Conversion - ((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_Elab (+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_Elab - (+Loc, "mismatching vector length; got %v, expect %v", - (+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. - declare - Src_Typ, Dst_Typ : Type_Acc; - begin - Src_Typ := Vtype; - Dst_Typ := Dtype; - loop - pragma Assert (Src_Typ.Alast = Dst_Typ.Alast); - if Src_Typ.Abound.Len /= Dst_Typ.Abound.Len then - Error_Msg_Elab (+Loc, "mismatching array bounds"); - return No_Valtyp; - end if; - exit when Src_Typ.Alast; - Src_Typ := Src_Typ.Arr_El; - Dst_Typ := Dst_Typ.Arr_El; - end loop; - -- TODO: check element. - if Bounds then - return Reshape_Value (Vt, Dtype); - else - return Vt; - end if; - end; - 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; + return Synth_Subtype_Conversion + (Netlists.Builders.No_Context, Vt, Dtype, Bounds, Loc); end Exec_Subtype_Conversion; function Exec_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) @@ -244,7 +115,7 @@ package body Elab.Vhdl_Expr is Dtype : Type_Acc; begin -- The value is supposed to be static. - V := Exec_Expression (Syn_Inst, Param); + V := Synth_Expression (Syn_Inst, Param); if V = No_Valtyp then return No_Valtyp; end if; @@ -338,7 +209,7 @@ package body Elab.Vhdl_Expr is Res : Memtyp; begin -- The parameter is expected to be static. - V := Exec_Expression (Syn_Inst, Param); + V := Synth_Expression (Syn_Inst, Param); if V = No_Valtyp then return No_Valtyp; end if; @@ -368,33 +239,6 @@ package body Elab.Vhdl_Expr is return Create_Value_Memtyp (Res); end Exec_Instance_Name_Attribute; - -- 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_Elab (+Loc, "index not within bounds"); - Elab.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; - procedure Check_Matching_Bounds (L, R : Type_Acc; Loc : Node) is begin if not Are_Types_Equal (L, R) then @@ -444,219 +288,6 @@ package body Elab.Vhdl_Expr is return Res; end Create_Onedimensional_Array_Subtype; - procedure Exec_Indexed_Name (Syn_Inst : Synth_Instance_Acc; - Name : Node; - Pfx_Type : Type_Acc; - Off : out Value_Offsets) - is - Indexes : constant Iir_Flist := Get_Index_List (Name); - Arr_Typ : Type_Acc; - Idx_Expr : Node; - Idx_Val : Valtyp; - Bnd : Bound_Type; - Stride : Uns32; - Idx_Off : Value_Offsets; - begin - Off := (0, 0); - - Arr_Typ := Pfx_Type; - for I in 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 := Exec_Expression_With_Basetype (Syn_Inst, Idx_Expr); - if Idx_Val = No_Valtyp then - -- Propagate errorc - Off := (0, 0); - return; - end if; - - Strip_Const (Idx_Val); - pragma Assert (Is_Static (Idx_Val.Val)); - - Bnd := Get_Array_Bound (Arr_Typ); - - if I = Flist_First then - Stride := 1; - else - Stride := Bnd.Len; - end if; - - Idx_Off := Index_To_Offset (Syn_Inst, Bnd, - Get_Static_Discrete (Idx_Val), Name); - Off.Net_Off := Off.Net_Off * Stride + Idx_Off.Net_Off; - Off.Mem_Off := Off.Mem_Off * Size_Type (Stride) + Idx_Off.Mem_Off; - - - Arr_Typ := Arr_Typ.Arr_El; - end loop; - - Off.Net_Off := Off.Net_Off * Arr_Typ.W; - Off.Mem_Off := Off.Mem_Off * Arr_Typ.Sz; - end Exec_Indexed_Name; - - procedure Exec_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_Elab (+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_Elab (+Name, "index not within bounds"); - Elab.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 Exec_Slice_Const_Suffix; - - procedure Exec_Slice_Suffix (Syn_Inst : Synth_Instance_Acc; - Name : Node; - Pfx_Bnd : Bound_Type; - El_Typ : Type_Acc; - Res_Bnd : out Bound_Type; - Off : out Value_Offsets) - is - Expr : constant Node := Get_Suffix (Name); - Left, Right : Valtyp; - Dir : Direction_Type; - begin - Off := (0, 0); - - case Get_Kind (Expr) is - when Iir_Kind_Range_Expression => - -- As the range may be dynamic, cannot use synth_discrete_range. - Left := Exec_Expression_With_Basetype - (Syn_Inst, Get_Left_Limit (Expr)); - Right := Exec_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); - Exec_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_Elab - (+Expr, "only range expression supported for slices"); - Res_Bnd := (Dir => Dir_To, Left => 1, Right => 0, Len => 0); - return; - end case; - - pragma Assert (Is_Static (Left.Val)); - pragma Assert (Is_Static (Right.Val)); - Exec_Slice_Const_Suffix (Syn_Inst, Expr, - Name, Pfx_Bnd, - Get_Static_Discrete (Left), - Get_Static_Discrete (Right), - Dir, - El_Typ, Res_Bnd, Off); - end Exec_Slice_Suffix; - - function Exec_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 Exec_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 := Exec_Expression (Syn_Inst, Get_Prefix (Name)); - return Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); - end; - when others => - Error_Kind ("exec_name", Name); - end case; - end Exec_Name; - function Exec_Name_Subtype (Syn_Inst : Synth_Instance_Acc; Name : Node) return Type_Acc is begin @@ -702,7 +333,7 @@ package body Elab.Vhdl_Expr is declare Val : Valtyp; begin - Val := Exec_Expression (Syn_Inst, Get_Prefix (Name)); + Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); Val := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); return Val.Typ; end; @@ -718,101 +349,6 @@ package body Elab.Vhdl_Expr is end case; end Exec_Name_Subtype; - procedure Exec_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; - Pfx : Node; - Dest_Base : out Valtyp; - Dest_Typ : out Type_Acc; - Dest_Off : out Value_Offsets) is - begin - case Get_Kind (Pfx) is - when Iir_Kind_Simple_Name => - Exec_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), - Dest_Base, Dest_Typ, Dest_Off); - 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_File_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Object_Alias_Declaration => - declare - Targ : constant Valtyp := Get_Value (Syn_Inst, Pfx); - begin - Dest_Typ := Targ.Typ; - - if Targ.Val.Kind = Value_Alias then - -- Replace alias by the aliased name. - Dest_Base := (Targ.Val.A_Typ, Targ.Val.A_Obj); - Dest_Off := Targ.Val.A_Off; - else - Dest_Base := Targ; - Dest_Off := (0, 0); - end if; - end; - - when Iir_Kind_Indexed_Name => - declare - Off : Value_Offsets; - begin - Exec_Assignment_Prefix - (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); - Strip_Const (Dest_Base); - Exec_Indexed_Name (Syn_Inst, Pfx, Dest_Typ, Off); - - Dest_Off := Dest_Off + Off; - - while not Dest_Typ.Alast loop - Dest_Typ := Get_Array_Element (Dest_Typ); - end loop; - Dest_Typ := Get_Array_Element (Dest_Typ); - end; - - when Iir_Kind_Selected_Element => - declare - Idx : constant Iir_Index32 := - Get_Element_Position (Get_Named_Entity (Pfx)); - begin - Exec_Assignment_Prefix - (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); - Dest_Off := Dest_Off + Dest_Typ.Rec.E (Idx + 1).Offs; - - Dest_Typ := Dest_Typ.Rec.E (Idx + 1).Typ; - end; - - when Iir_Kind_Slice_Name => - declare - Pfx_Bnd : Bound_Type; - El_Typ : Type_Acc; - Res_Bnd : Bound_Type; - Sl_Off : Value_Offsets; - begin - Exec_Assignment_Prefix - (Syn_Inst, Get_Prefix (Pfx), Dest_Base, Dest_Typ, Dest_Off); - Strip_Const (Dest_Base); - - Get_Onedimensional_Array_Bounds (Dest_Typ, Pfx_Bnd, El_Typ); - Exec_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ, - Res_Bnd, Sl_Off); - - -- Fixed slice. - Dest_Typ := Create_Onedimensional_Array_Subtype - (Dest_Typ, Res_Bnd, El_Typ); - Dest_Off.Net_Off := Dest_Off.Net_Off + Sl_Off.Net_Off; - Dest_Off.Mem_Off := Dest_Off.Mem_Off + Sl_Off.Mem_Off; - end; - - when Iir_Kind_Function_Call => - Dest_Base := Synth_Expression (Syn_Inst, Pfx); - Dest_Typ := Dest_Base.Typ; - Dest_Off := (0, 0); - - when others => - Error_Kind ("exec_assignment_prefix", Pfx); - end case; - end Exec_Assignment_Prefix; - -- Return the type of EXPR without evaluating it. function Exec_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Type_Acc is @@ -828,16 +364,19 @@ package body Elab.Vhdl_Expr is return Exec_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr)); when Iir_Kind_Slice_Name => declare + use Netlists; Pfx_Typ : Type_Acc; Pfx_Bnd : Bound_Type; El_Typ : Type_Acc; Res_Bnd : Bound_Type; Sl_Off : Value_Offsets; + Inp : Net; begin Pfx_Typ := Exec_Type_Of_Object (Syn_Inst, Get_Prefix (Expr)); Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ); - Exec_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, - Res_Bnd, Sl_Off); + Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ, + Res_Bnd, Inp, Sl_Off); + pragma Assert (Inp = No_Net); return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd, El_Typ); end; @@ -865,7 +404,7 @@ package body Elab.Vhdl_Expr is Res : Valtyp; begin -- Maybe do not dereference it if its type is known ? - Val := Exec_Expression (Syn_Inst, Get_Prefix (Expr)); + Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr)); Res := Elab.Vhdl_Heap.Synth_Dereference (Read_Access (Val)); return Res.Typ; end; @@ -881,96 +420,6 @@ package body Elab.Vhdl_Expr is return null; end Exec_Type_Of_Object; - function Exec_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 := Exec_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_Elab (+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_Elab (+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 - | Type_Array - | Type_Unbounded_Array => - return Val; - when others => - Error_Msg_Elab - (+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_Elab (+Conv, "unhandled type conversion"); - return No_Valtyp; - end case; - end Exec_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_Elab - (+Loc, "unhandled predefined IEEE operator %i", +Imp); - Error_Msg_Elab - (+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 Exec_String_Literal (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) return Valtyp @@ -1019,388 +468,4 @@ package body Elab.Vhdl_Expr is return Res; end Exec_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 Exec_Short_Circuit (Syn_Inst : Synth_Instance_Acc; - Val : Int64; - Left_Expr : Node; - Right_Expr : Node; - Typ : Type_Acc) return Valtyp - is - Left : Valtyp; - Right : Valtyp; - begin - Left := Exec_Expression_With_Type (Syn_Inst, Left_Expr, Typ); - if Left = No_Valtyp then - -- Propagate error. - return No_Valtyp; - end if; - pragma Assert (Is_Static (Left.Val)); - if Get_Static_Discrete (Left) = Val then - -- Short-circuit when the left operand determines the result. - return Create_Value_Discrete (Val, Typ); - end if; - - Strip_Const (Left); - Right := Exec_Expression_With_Type (Syn_Inst, Right_Expr, Typ); - if Right = No_Valtyp then - -- Propagate error. - return No_Valtyp; - end if; - Strip_Const (Right); - - pragma Assert (Is_Static (Right.Val)); - if Get_Static_Discrete (Right) = Val then - -- If the right operand can determine the result, return it. - return Create_Value_Discrete (Val, Typ); - end if; - - -- Return a static value if both operands are static. - -- Note: we know the value of left if it is not constant. - return Create_Value_Discrete (Get_Static_Discrete (Right), Typ); - end Exec_Short_Circuit; - - function Exec_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); - begin - -- Specially handle short-circuit operators. - case Def is - when Iir_Predefined_Boolean_And => - return Exec_Short_Circuit - (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr), - Boolean_Type); - when Iir_Predefined_Boolean_Or => - return Exec_Short_Circuit - (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr), - Boolean_Type); - when Iir_Predefined_Bit_And => - return Exec_Short_Circuit - (Syn_Inst, 0, Get_Left (Expr), Get_Right (Expr), - Bit_Type); - when Iir_Predefined_Bit_Or => - return Exec_Short_Circuit - (Syn_Inst, 1, Get_Left (Expr), Get_Right (Expr), - Bit_Type); - 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 := Exec_Name (Syn_Inst, Expr); - if Res.Val.Kind = Value_Signal then - Vhdl_Errors.Error_Msg_Elab - (+Expr, "cannot use signal value during elaboration"); - return No_Valtyp; - end if; - if Res.Typ /= null - and then 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 Exec_Expression_With_Type - (Syn_Inst, Get_Named_Entity (Expr), Expr_Type); - when Iir_Kind_Indexed_Name - | Iir_Kind_Slice_Name => - declare - Base : Valtyp; - Typ : Type_Acc; - Off : Value_Offsets; - Res : Valtyp; - begin - Exec_Assignment_Prefix (Syn_Inst, Expr, Base, Typ, Off); - Res := Create_Value_Memory (Typ); - Copy_Memory (Res.Val.Mem, Base.Val.Mem + Off.Mem_Off, Typ.Sz); - return Res; - end; - when Iir_Kind_Selected_Element => - declare - Idx : constant Iir_Index32 := - Get_Element_Position (Get_Named_Entity (Expr)); - Pfx : constant Node := Get_Prefix (Expr); - Res_Typ : Type_Acc; - Val : Valtyp; - Res : Valtyp; - begin - Val := Exec_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)); - end if; - pragma Assert (Is_Static (Val.Val)); - Res := Create_Value_Memory (Res_Typ); - Copy_Memory - (Res.Val.Mem, - Val.Val.Mem + Val.Typ.Rec.E (Idx + 1).Offs.Mem_Off, - Res_Typ.Sz); - return Res; - end; - when Iir_Kind_Character_Literal => - return Exec_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 Exec_String_Literal (Syn_Inst, Expr, Expr_Type); - when Iir_Kind_Enumeration_Literal => - return Exec_Name (Syn_Inst, Expr); - when Iir_Kind_Type_Conversion => - return Exec_Type_Conversion (Syn_Inst, Expr); - when Iir_Kind_Qualified_Expression => - return Exec_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_Operators - | 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 Exec_Simple_Aggregate (Syn_Inst, Expr); - when Iir_Kind_Parenthesis_Expression => - return Exec_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 - Param : constant Node := Get_Parameter (Expr); - V : Valtyp; - Dtype : Type_Acc; - begin - V := Exec_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 Exec_Subtype_Conversion (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 Exec_Value_Attribute (Syn_Inst, Expr); - when Iir_Kind_Image_Attribute => - return Exec_Image_Attribute (Syn_Inst, Expr); - when Iir_Kind_Instance_Name_Attribute => - return Exec_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_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 := Exec_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_Elab (+Expr, "signal attribute not supported"); - return No_Valtyp; - when Iir_Kind_Overflow_Literal => - Error_Msg_Elab (+Expr, "out of bound expression"); - return No_Valtyp; - when others => - Error_Kind ("exec_expression_with_type", Expr); - end case; - end Exec_Expression_With_Type; - - function Exec_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 Exec_Expression_With_Type - (Syn_Inst, Expr, Get_Subtype_Object (Syn_Inst, Etype)); - end Exec_Expression; - - function Exec_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 Exec_Expression_With_Type (Syn_Inst, Expr, Basetype); - end Exec_Expression_With_Basetype; end Elab.Vhdl_Expr; |