diff options
Diffstat (limited to 'src/synth')
-rw-r--r-- | src/synth/synth-context.adb | 118 | ||||
-rw-r--r-- | src/synth/synth-context.ads | 60 | ||||
-rw-r--r-- | src/synth/synth-decls.adb | 164 | ||||
-rw-r--r-- | src/synth/synth-disp_vhdl.adb | 4 | ||||
-rw-r--r-- | src/synth/synth-expr.adb | 380 | ||||
-rw-r--r-- | src/synth/synth-expr.ads | 11 | ||||
-rw-r--r-- | src/synth/synth-files_operations.adb | 32 | ||||
-rw-r--r-- | src/synth/synth-heap.adb | 28 | ||||
-rw-r--r-- | src/synth/synth-heap.ads | 4 | ||||
-rw-r--r-- | src/synth/synth-insts.adb | 103 | ||||
-rw-r--r-- | src/synth/synth-oper.adb | 246 | ||||
-rw-r--r-- | src/synth/synth-oper.ads | 8 | ||||
-rw-r--r-- | src/synth/synth-static_oper.adb | 258 | ||||
-rw-r--r-- | src/synth/synth-static_oper.ads | 12 | ||||
-rw-r--r-- | src/synth/synth-static_proc.adb | 6 | ||||
-rw-r--r-- | src/synth/synth-stmts.adb | 358 | ||||
-rw-r--r-- | src/synth/synth-stmts.ads | 15 | ||||
-rw-r--r-- | src/synth/synth-values.adb | 107 | ||||
-rw-r--r-- | src/synth/synth-values.ads | 48 |
19 files changed, 1029 insertions, 933 deletions
diff --git a/src/synth/synth-context.adb b/src/synth/synth-context.adb index 0b6c73c72..f7bbb477a 100644 --- a/src/synth/synth-context.adb +++ b/src/synth/synth-context.adb @@ -21,7 +21,6 @@ with Ada.Unchecked_Deallocation; with Types; use Types; -with Tables; with Types_Utils; use Types_Utils; with Name_Table; use Name_Table; @@ -36,12 +35,6 @@ with Synth.Expr; use Synth.Expr; with Netlists.Locations; package body Synth.Context is - package Packages_Table is new Tables - (Table_Component_Type => Synth_Instance_Acc, - Table_Index_Type => Instance_Id, - Table_Low_Bound => 1, - Table_Initial => 16); - function Make_Base_Instance return Synth_Instance_Acc is Base : Base_Instance_Acc; @@ -69,7 +62,8 @@ package body Synth.Context is Uninst_Scope => null, Source_Scope => Null_Node, Elab_Objects => 0, - Objects => (others => null)); + Objects => (others => + (Kind => Obj_None))); return Res; end Make_Base_Instance; @@ -77,7 +71,6 @@ package body Synth.Context is begin -- TODO: really free. Build_Context := null; - Packages_Table.Init; end Free_Base_Instance; function Make_Instance (Parent : Synth_Instance_Acc; @@ -106,7 +99,8 @@ package body Synth.Context is Uninst_Scope => null, Source_Scope => Blk, Elab_Objects => 0, - Objects => (others => null)); + Objects => (others => + (Kind => Obj_None))); return Res; end Make_Instance; @@ -200,7 +194,7 @@ package body Synth.Context is return Boolean is begin for I in 1 .. Inst.Elab_Objects loop - if Inst.Objects (I).Kind /= Value_Subtype then + if Inst.Objects (I).Kind /= Obj_Subtype then return False; end if; end loop; @@ -213,20 +207,6 @@ package body Synth.Context is Inst.Is_Const := Val; end Set_Instance_Const; - function Create_Value_Instance (Inst : Synth_Instance_Acc) - return Value_Acc is - begin - Packages_Table.Append (Inst); - return Create_Value_Instance (Packages_Table.Last); - end Create_Value_Instance; - - function Get_Value_Instance (Inst : Instance_Id) - return Synth_Instance_Acc is - begin - pragma Assert (Inst in Packages_Table.First .. Packages_Table.Last); - return Packages_Table.Table (Inst); - end Get_Value_Instance; - procedure Create_Object (Syn_Inst : Synth_Instance_Acc; Slot : Object_Slot_Type; Num : Object_Slot_Type := 1) is @@ -236,7 +216,7 @@ package body Synth.Context is -- commons (same scope), and package annotation order can be different -- from package elaboration order (eg: body). if Slot /= Syn_Inst.Elab_Objects + 1 - or else Syn_Inst.Objects (Slot) /= null + or else Syn_Inst.Objects (Slot).Kind /= Obj_None then Error_Msg_Elab ("synth: bad elaboration order of objects"); raise Internal_Error; @@ -245,43 +225,69 @@ package body Synth.Context is end Create_Object; procedure Create_Object_Force - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Val : Value_Acc) + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) is Info : constant Sim_Info_Acc := Get_Info (Decl); begin - pragma Assert (Val = null or else Syn_Inst.Objects (Info.Slot) = null); - Syn_Inst.Objects (Info.Slot) := Val; + pragma Assert + (Syn_Inst.Objects (Info.Slot).Kind = Obj_None + or else Vt = (null, null) + or else Syn_Inst.Objects (Info.Slot) = (Kind => Obj_Object, + Obj => No_Valtyp)); + Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Object, Obj => Vt); end Create_Object_Force; procedure Create_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Val : Value_Acc) + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp) is Info : constant Sim_Info_Acc := Get_Info (Decl); begin Create_Object (Syn_Inst, Info.Slot, 1); - Create_Object_Force (Syn_Inst, Decl, Val); + Create_Object_Force (Syn_Inst, Decl, Vt); end Create_Object; - procedure Create_Package_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Val : Value_Acc) + procedure Create_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc) is + pragma Assert (Typ /= null); Info : constant Sim_Info_Acc := Get_Info (Decl); begin - pragma Assert (Syn_Inst.Objects (Info.Pkg_Slot) = null); - Syn_Inst.Objects (Info.Pkg_Slot) := Val; + Create_Object (Syn_Inst, Info.Slot, 1); + pragma Assert (Syn_Inst.Objects (Info.Slot).Kind = Obj_None); + Syn_Inst.Objects (Info.Slot) := (Kind => Obj_Subtype, T_Typ => Typ); + end Create_Subtype_Object; + + procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Inst : Synth_Instance_Acc; + Is_Global : Boolean) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + begin + if Is_Global then + pragma Assert (Syn_Inst.Objects (Info.Pkg_Slot).Kind = Obj_None); + pragma Assert (Syn_Inst.Up_Block = null); + null; + else + pragma Assert (Syn_Inst.Up_Block /= null); + Create_Object (Syn_Inst, Info.Slot, 1); + end if; + Syn_Inst.Objects (Info.Pkg_Slot) := (Kind => Obj_Instance, + I_Inst => Inst); end Create_Package_Object; function Get_Package_Object - (Syn_Inst : Synth_Instance_Acc; Info : Sim_Info_Acc) return Value_Acc + (Syn_Inst : Synth_Instance_Acc; Info : Sim_Info_Acc) + return Synth_Instance_Acc is Parent : Synth_Instance_Acc; begin Parent := Get_Instance_By_Scope (Syn_Inst, Info.Pkg_Parent); - return Parent.Objects (Info.Pkg_Slot); + return Parent.Objects (Info.Pkg_Slot).I_Inst; end Get_Package_Object; function Get_Package_Object - (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Value_Acc is + (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc is begin return Get_Package_Object (Syn_Inst, Get_Info (Pkg)); end Get_Package_Object; @@ -303,7 +309,7 @@ package body Synth.Context is then Error_Msg_Elab ("synth: bad destroy order"); end if; - Syn_Inst.Objects (Slot) := null; + Syn_Inst.Objects (Slot) := (Kind => Obj_None); Syn_Inst.Elab_Objects := Slot - 1; end Destroy_Object; @@ -312,7 +318,7 @@ package body Synth.Context is Obj : Node) is Obj_Type : constant Node := Get_Type (Obj); - Otyp : constant Type_Acc := Get_Value_Type (Syn_Inst, Obj_Type); + Otyp : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Obj_Type); Val : Value_Acc; Wid : Wire_Id; begin @@ -323,7 +329,7 @@ package body Synth.Context is end if; Val := Create_Value_Wire (Wid, Otyp); - Create_Object (Syn_Inst, Obj, Val); + Create_Object (Syn_Inst, Obj, (Otyp, Val)); end Create_Wire_Object; function Get_Instance_By_Scope @@ -363,12 +369,7 @@ package body Synth.Context is end; else -- Instantiated package. - declare - Inst : Value_Acc; - begin - Inst := Get_Package_Object (Syn_Inst, Scope); - return Get_Value_Instance (Inst.Instance); - end; + return Get_Package_Object (Syn_Inst, Scope); end if; when others => raise Internal_Error; @@ -386,25 +387,25 @@ package body Synth.Context is return Get_Info (Parent); end Get_Parent_Scope; - function Get_Value (Syn_Inst: Synth_Instance_Acc; Obj : Node) - return Value_Acc + return Valtyp is Info : constant Sim_Info_Acc := Get_Info (Obj); Obj_Inst : Synth_Instance_Acc; begin Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope); - return Obj_Inst.Objects (Info.Slot); + return Obj_Inst.Objects (Info.Slot).Obj; end Get_Value; - function Get_Value_Type (Syn_Inst : Synth_Instance_Acc; Atype : Node) - return Type_Acc + function Get_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc is - Val : Value_Acc; + Info : constant Sim_Info_Acc := Get_Info (Decl); + Obj_Inst : Synth_Instance_Acc; begin - Val := Get_Value (Syn_Inst, Atype); - return Val.Typ; - end Get_Value_Type; + Obj_Inst := Get_Instance_By_Scope (Syn_Inst, Info.Obj_Scope); + return Obj_Inst.Objects (Info.Slot).T_Typ; + end Get_Subtype_Object; function Vec2net (Val : Value_Acc) return Net is begin @@ -621,4 +622,9 @@ package body Synth.Context is raise Internal_Error; end case; end Get_Net; + + function Get_Net (Val : Valtyp) return Net is + begin + return Get_Net (Val.Val); + end Get_Net; end Synth.Context; diff --git a/src/synth/synth-context.ads b/src/synth/synth-context.ads index 85962988b..9e66b1281 100644 --- a/src/synth/synth-context.ads +++ b/src/synth/synth-context.ads @@ -18,13 +18,15 @@ -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. -with Synth.Environment; use Synth.Environment; -with Synth.Values; use Synth.Values; -with Vhdl.Annotations; use Vhdl.Annotations; with Netlists; use Netlists; with Netlists.Builders; + +with Vhdl.Annotations; use Vhdl.Annotations; with Vhdl.Nodes; use Vhdl.Nodes; +with Synth.Environment; use Synth.Environment; +with Synth.Values; use Synth.Values; + package Synth.Context is -- Values are stored into Synth_Instance, which is parallel to simulation -- Block_Instance_Type. @@ -91,15 +93,20 @@ package Synth.Context is function Get_Source_Scope (Inst : Synth_Instance_Acc) return Node; procedure Create_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Val : Value_Acc); + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); + + procedure Create_Package_Object (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Inst : Synth_Instance_Acc; + Is_Global : Boolean); - procedure Create_Package_Object - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Val : Value_Acc); + procedure Create_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Typ : Type_Acc); -- Force the value of DECL, without checking for elaboration order. -- It is for deferred constants. procedure Create_Object_Force - (Syn_Inst : Synth_Instance_Acc; Decl : Node; Val : Value_Acc); + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Vt : Valtyp); procedure Destroy_Object (Syn_Inst : Synth_Instance_Acc; Decl : Node); @@ -112,21 +119,19 @@ package Synth.Context is -- Get the value of OBJ. function Get_Value (Syn_Inst : Synth_Instance_Acc; Obj : Node) - return Value_Acc; - -- Wrapper around Get_Value for types. - function Get_Value_Type (Syn_Inst : Synth_Instance_Acc; Atype : Node) - return Type_Acc; + return Valtyp; -- Get a net from a scalar/vector value. This will automatically create -- a net for literals. function Get_Net (Val : Value_Acc) return Net; - - function Create_Value_Instance (Inst : Synth_Instance_Acc) - return Value_Acc; - function Get_Value_Instance (Inst : Instance_Id) return Synth_Instance_Acc; + function Get_Net (Val : Valtyp) return Net; function Get_Package_Object - (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Value_Acc; + (Syn_Inst : Synth_Instance_Acc; Pkg : Node) return Synth_Instance_Acc; + + -- Return the type for DECL (a subtype indication). + function Get_Subtype_Object + (Syn_Inst : Synth_Instance_Acc; Decl : Node) return Type_Acc; -- Return the scope of the parent of BLK. Deals with architecture bodies. function Get_Parent_Scope (Blk : Node) return Sim_Info_Acc; @@ -134,7 +139,28 @@ package Synth.Context is procedure Set_Uninstantiated_Scope (Syn_Inst : Synth_Instance_Acc; Bod : Node); private - type Objects_Array is array (Object_Slot_Type range <>) of Value_Acc; + type Obj_Kind is + ( + Obj_None, + Obj_Object, + Obj_Subtype, + Obj_Instance + ); + + type Obj_Type (Kind : Obj_Kind := Obj_None) is record + case Kind is + when Obj_None => + null; + when Obj_Object => + Obj : Valtyp; + when Obj_Subtype => + T_Typ : Type_Acc; + when Obj_Instance => + I_Inst : Synth_Instance_Acc; + end case; + end record; + + type Objects_Array is array (Object_Slot_Type range <>) of Obj_Type; type Base_Instance_Type is limited record Builder : Netlists.Builders.Context_Acc; diff --git a/src/synth/synth-decls.adb b/src/synth/synth-decls.adb index ff3556ae3..4d1914cc0 100644 --- a/src/synth/synth-decls.adb +++ b/src/synth/synth-decls.adb @@ -44,21 +44,21 @@ package body Synth.Decls is (Syn_Inst : Synth_Instance_Acc; Atype : Node); procedure Create_Var_Wire - (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Value_Acc) + (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Valtyp) is - Val : constant Value_Acc := Get_Value (Syn_Inst, Decl); + Vt : constant Valtyp := Get_Value (Syn_Inst, Decl); Value : Net; Ival : Net; W : Width; Name : Sname; begin - case Val.Kind is + case Vt.Val.Kind is when Value_Wire => -- FIXME: get the width directly from the wire ? - W := Get_Type_Width (Val.Typ); + W := Get_Type_Width (Vt.Typ); Name := New_Sname_User (Get_Identifier (Decl), Get_Sname (Syn_Inst)); - if Init /= null then + if Init /= No_Valtyp then Ival := Get_Net (Init); pragma Assert (Get_Width (Ival) = W); Value := Build_Isignal (Get_Build (Syn_Inst), Name, Ival); @@ -66,7 +66,7 @@ package body Synth.Decls is Value := Build_Signal (Get_Build (Syn_Inst), Name, W); end if; Set_Location (Value, Decl); - Set_Wire_Gate (Val.W, Value); + Set_Wire_Gate (Vt.Val.W, Value); when others => raise Internal_Error; end case; @@ -89,7 +89,7 @@ package body Synth.Decls is Typ : Type_Acc; begin Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); - El_Typ := Get_Value_Type (Syn_Inst, El_Type); + El_Typ := Get_Subtype_Object (Syn_Inst, El_Type); if El_Typ.Kind in Type_Nets and then Ndims = 1 then Typ := Create_Unbounded_Vector (El_Typ); @@ -130,7 +130,7 @@ package body Synth.Decls is Off := 0; for I in Flist_First .. Flist_Last (El_List) loop El := Get_Nth_Element (El_List, I); - El_Typ := Get_Value_Type (Syn_Inst, Get_Type (El)); + El_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (El)); Rec_Els.E (Iir_Index32 (I + 1)) := (Off => Off, Typ => El_Typ); Off := Off + Get_Type_Width (El_Typ); @@ -147,7 +147,7 @@ package body Synth.Decls is Typ : Type_Acc; begin Synth_Subtype_Indication_If_Anonymous (Syn_Inst, Des_Type); - Des_Typ := Get_Value_Type (Syn_Inst, Des_Type); + Des_Typ := Get_Subtype_Object (Syn_Inst, Des_Type); Typ := Create_Access_Type (Des_Typ); return Typ; @@ -160,7 +160,7 @@ package body Synth.Decls is File_Typ : Type_Acc; Typ : Type_Acc; begin - File_Typ := Get_Value_Type (Syn_Inst, File_Type); + File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); Typ := Create_File_Type (File_Typ); return Typ; @@ -208,7 +208,7 @@ package body Synth.Decls is Vhdl.Errors.Error_Kind ("synth_type_definition", Def); end case; if Typ /= null then - Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); + Create_Subtype_Object (Syn_Inst, Def, Typ); end if; end Synth_Type_Definition; @@ -249,7 +249,7 @@ package body Synth.Decls is when others => Vhdl.Errors.Error_Kind ("synth_anonymous_type_definition", Def); end case; - Create_Object (Syn_Inst, Def, Create_Value_Subtype (Typ)); + Create_Subtype_Object (Syn_Inst, Def, Typ); end Synth_Anonymous_Type_Definition; function Synth_Discrete_Range_Constraint @@ -303,11 +303,11 @@ package body Synth.Decls is -- That's an alias. -- FIXME: maybe a resolution function was added? -- FIXME: also handle resolution added in element subtype. - return Get_Value_Type (Syn_Inst, Ptype); + return Get_Subtype_Object (Syn_Inst, Ptype); end if; end if; - Btyp := Get_Value_Type (Syn_Inst, Get_Base_Type (Atype)); + Btyp := Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype)); case Btyp.Kind is when Type_Unbounded_Vector => if Get_Index_Constraint_Flag (Atype) then @@ -322,7 +322,7 @@ package body Synth.Decls is end if; when Type_Unbounded_Array => -- FIXME: partially constrained arrays, subtype in indexes... - Etyp := Get_Value_Type (Syn_Inst, El_Type); + Etyp := Get_Subtype_Object (Syn_Inst, El_Type); if Get_Index_Constraint_Flag (Atype) then Bnds := Create_Bound_Array (Dim_Type (Get_Nbr_Elements (St_Indexes))); @@ -354,7 +354,7 @@ package body Synth.Decls is | Iir_Kind_Enumeration_Subtype_Definition => declare Btype : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Base_Type (Atype)); + Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype)); Rng : Discrete_Range_Type; W : Width; begin @@ -388,8 +388,7 @@ package body Synth.Decls is Typ : Type_Acc; begin Typ := Synth_Subtype_Indication (Syn_Inst, Atype); - pragma Assert (Typ /= null); - Create_Object (Syn_Inst, Atype, Create_Value_Subtype (Typ)); + Create_Subtype_Object (Syn_Inst, Atype, Typ); end Synth_Subtype_Indication; procedure Synth_Anonymous_Subtype_Indication @@ -453,8 +452,8 @@ package body Synth.Decls is Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl); First_Decl : Node; Decl_Type : Node; - Val : Value_Acc; - Cst : Value_Acc; + Val : Valtyp; + Cst : Valtyp; Obj_Type : Type_Acc; begin Synth_Declaration_Type (Syn_Inst, Decl); @@ -463,7 +462,7 @@ package body Synth.Decls is then -- Create the object (except for full declaration of a -- deferred constant). - Create_Object (Syn_Inst, Decl, null); + Create_Object (Syn_Inst, Decl, No_Valtyp); end if; -- Initialize the value (except for a deferred declaration). if Deferred_Decl = Null_Node then @@ -490,18 +489,18 @@ package body Synth.Decls is end if; Last_Type := Decl_Type; end if; - Obj_Type := Get_Value_Type (Syn_Inst, Decl_Type); + Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type); Val := Synth_Expression_With_Type (Syn_Inst, Get_Default_Value (Decl), Obj_Type); - if Val = null then + if Val = No_Valtyp then Set_Error (Syn_Inst); return; end if; Val := Synth_Subtype_Conversion (Val, Obj_Type, True, Decl); -- For constant functions, the value must be constant. pragma Assert (not Get_Instance_Const (Syn_Inst) - or else Is_Static (Val)); - case Val.Kind is + or else Is_Static (Val.Val)); + case Val.Val.Kind is when Value_Const | Value_Alias => Cst := Val; @@ -517,10 +516,10 @@ package body Synth.Decls is is Decl : constant Node := Get_Attribute_Designator (Spec); Value : Iir_Attribute_Value; - Val : Value_Acc; + Val : Valtyp; Val_Type : Type_Acc; begin - Val_Type := Get_Value_Type + Val_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Get_Named_Entity (Decl))); Value := Get_Attribute_Value_Spec_Chain (Spec); while Value /= Null_Iir loop @@ -569,12 +568,12 @@ package body Synth.Decls is is use Vhdl.Std_Package; begin - Create_Object + Create_Subtype_Object (Syn_Inst, Convertible_Integer_Type_Definition, - Get_Value (Syn_Inst, Universal_Integer_Type_Definition)); - Create_Object + Get_Subtype_Object (Syn_Inst, Universal_Integer_Type_Definition)); + Create_Subtype_Object (Syn_Inst, Convertible_Real_Type_Definition, - Get_Value (Syn_Inst, Universal_Real_Type_Definition)); + Get_Subtype_Object (Syn_Inst, Universal_Real_Type_Definition)); end Synth_Convertible_Declarations; function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc; @@ -582,16 +581,14 @@ package body Synth.Decls is return Synth_Instance_Acc is Syn_Inst : Synth_Instance_Acc; - Val : Value_Acc; begin Syn_Inst := Make_Instance (Parent_Inst, Pkg); - Val := Create_Value_Instance (Syn_Inst); if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then - -- Global package: in no particular order. - Create_Package_Object (Parent_Inst, Pkg, Val); + -- Global package. + Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, True); else -- Local package: check elaboration order. - Create_Object (Parent_Inst, Pkg, Val); + Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, False); end if; return Syn_Inst; end Create_Package_Instance; @@ -617,21 +614,16 @@ package body Synth.Decls is procedure Synth_Package_Body (Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node) is - Val : Value_Acc; + Pkg_Inst : Synth_Instance_Acc; begin if Is_Uninstantiated_Package (Pkg) then -- Nothing to do (yet) for uninstantiated packages. return; end if; - if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then - Val := Get_Package_Object (Parent_Inst, Pkg); - else - Val := Get_Value (Parent_Inst, Pkg); - end if; + Pkg_Inst := Get_Package_Object (Parent_Inst, Pkg); - Synth_Declarations (Get_Value_Instance (Val.Instance), - Get_Declaration_Chain (Bod)); + Synth_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod)); end Synth_Package_Body; procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc; @@ -644,7 +636,7 @@ package body Synth.Decls is Assoc : Node; Assoc_Inter : Node; Actual : Node; - Val : Value_Acc; + Val : Valtyp; begin Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; @@ -652,7 +644,7 @@ package body Synth.Decls is Inter := Get_Association_Interface (Assoc, Assoc_Inter); Synth_Declaration_Type (Sub_Inst, Inter); - Inter_Type := Get_Value_Type (Sub_Inst, Get_Type (Inter)); + Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); pragma Assert (Iir_Parameter_Modes (Get_Mode (Inter)) = Iir_In_Mode); case Get_Kind (Assoc) is @@ -670,7 +662,7 @@ package body Synth.Decls is Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc); - pragma Assert (Is_Static (Val)); + pragma Assert (Is_Static (Val.Val)); Create_Object (Sub_Inst, Inter, Val); @@ -716,34 +708,36 @@ package body Synth.Decls is is Def : constant Iir := Get_Default_Value (Decl); -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; - Init : Value_Acc; - Obj_Type : Type_Acc; + Init : Valtyp; + Obj_Typ : Type_Acc; begin Synth_Declaration_Type (Syn_Inst, Decl); - Obj_Type := Get_Value_Type (Syn_Inst, Get_Type (Decl)); - if not Obj_Type.Is_Synth + Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); + if not Obj_Typ.Is_Synth and then not Get_Instance_Const (Syn_Inst) then Error_Msg_Synth (+Decl, "variable with access type is not synthesizable"); -- FIXME: use a poison value ? - Create_Object (Syn_Inst, Decl, Create_Value_Default (Obj_Type)); + Create_Object (Syn_Inst, Decl, + (Obj_Typ, Create_Value_Default (Obj_Typ))); else if Is_Valid (Def) then - Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Type); - Init := Synth_Subtype_Conversion (Init, Obj_Type, False, Decl); + Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); + Init := Synth_Subtype_Conversion (Init, Obj_Typ, False, Decl); else - Init := Create_Value_Default (Obj_Type); + Init := Create_Value_Default (Obj_Typ); end if; if Get_Instance_Const (Syn_Inst) then - Create_Object (Syn_Inst, Decl, Unshare (Init, Current_Pool)); + Init.Val := Unshare (Init.Val, Current_Pool); + Create_Object (Syn_Inst, Decl, Init); else Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); Create_Var_Wire (Syn_Inst, Decl, Init); if Is_Subprg then Phi_Assign (Get_Build (Syn_Inst), - Get_Value (Syn_Inst, Decl).W, Get_Net (Init), 0); + Get_Value (Syn_Inst, Decl).Val.W, Get_Net (Init), 0); end if; end if; end if; @@ -753,35 +747,35 @@ package body Synth.Decls is (Syn_Inst : Synth_Instance_Acc; Decl : Node) is Atype : constant Node := Get_Declaration_Type (Decl); - Obj : Value_Acc; Off : Uns32; Voff : Net; Rdwd : Width; - Typ : Type_Acc; - Res : Value_Acc; - Obj_Type : Type_Acc; + Res : Valtyp; + Obj_Typ : Type_Acc; + Vt : Valtyp; begin -- Subtype indication may not be present. if Atype /= Null_Node then Synth_Subtype_Indication (Syn_Inst, Atype); - Obj_Type := Get_Value_Type (Syn_Inst, Atype); + Obj_Typ := Get_Subtype_Object (Syn_Inst, Atype); else - Obj_Type := null; + Obj_Typ := null; end if; Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), - Obj, Off, Voff, Rdwd, Typ); + Vt, Off, Voff, Rdwd); pragma Assert (Voff = No_Net); - if Obj.Kind = Value_Net then + if Vt.Val.Kind = Value_Net then -- Object is a net if it is not writable. Extract the -- bits for the alias. Res := Create_Value_Net - (Build2_Extract (Get_Build (Syn_Inst), Obj.N, Off, Typ.W), Typ); + (Build2_Extract (Get_Build (Syn_Inst), Vt.Val.N, Off, Vt.Typ.W), + Vt.Typ); else - Res := Create_Value_Alias (Obj, Off, Typ); + Res := Create_Value_Alias (Vt.Val, Off, Vt.Typ); end if; - if Obj_Type /= null then - Res := Synth_Subtype_Conversion (Res, Obj_Type, True, Decl); + if Obj_Typ /= null then + Res := Synth_Subtype_Conversion (Res, Obj_Typ, True, Decl); end if; Create_Object (Syn_Inst, Decl, Res); end Synth_Object_Alias_Declaration; @@ -797,7 +791,7 @@ package body Synth.Decls is when Iir_Kind_Interface_Variable_Declaration => -- Ignore default value. Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); - Create_Var_Wire (Syn_Inst, Decl, null); + Create_Var_Wire (Syn_Inst, Decl, No_Valtyp); when Iir_Kind_Constant_Declaration => Synth_Constant_Declaration (Syn_Inst, Decl, Last_Type); when Iir_Kind_Signal_Declaration => @@ -805,17 +799,17 @@ package body Synth.Decls is declare Def : constant Iir := Get_Default_Value (Decl); -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; - Init : Value_Acc; - Obj_Type : Type_Acc; + Init : Valtyp; + Obj_Typ : Type_Acc; begin Create_Wire_Object (Syn_Inst, Wire_Signal, Decl); if Is_Valid (Def) then - Obj_Type := Get_Value_Type (Syn_Inst, Get_Type (Decl)); - Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Type); + Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); + Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); Init := Synth_Subtype_Conversion - (Init, Obj_Type, False, Decl); + (Init, Obj_Typ, False, Decl); else - Init := null; + Init := No_Valtyp; end if; Create_Var_Wire (Syn_Inst, Decl, Init); end; @@ -857,9 +851,9 @@ package body Synth.Decls is begin F := Synth.Files_Operations.Elaborate_File_Declaration (Syn_Inst, Decl); - Obj_Typ := Get_Value_Type (Syn_Inst, Get_Type (Decl)); + Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); Res := Create_Value_File (Obj_Typ, F); - Create_Object (Syn_Inst, Decl, Res); + Create_Object (Syn_Inst, Decl, (Obj_Typ, Res)); end; when Iir_Kind_Psl_Default_Clock => -- Ignored; directly used by PSL directives. @@ -891,19 +885,19 @@ package body Synth.Decls is procedure Finalize_Signal (Syn_Inst : Synth_Instance_Acc; Decl : Node) is use Netlists.Gates; - Val : Value_Acc; + Vt : Valtyp; Gate_Net : Net; Gate : Instance; Drv : Net; Def_Val : Net; begin - Val := Get_Value (Syn_Inst, Decl); - if Val = null then + Vt := Get_Value (Syn_Inst, Decl); + if Vt = No_Valtyp then pragma Assert (Is_Error (Syn_Inst)); return; end if; - Gate_Net := Get_Wire_Gate (Val.W); + Gate_Net := Get_Wire_Gate (Vt.Val.W); Gate := Get_Net_Parent (Gate_Net); case Get_Id (Gate) is when Id_Signal => @@ -935,7 +929,7 @@ package body Synth.Decls is Connect (Get_Input (Gate, 0), Def_Val); end if; - Free_Wire (Val.W); + Free_Wire (Vt.Val.W); end Finalize_Signal; procedure Finalize_Declaration @@ -946,9 +940,9 @@ package body Synth.Decls is | Iir_Kind_Interface_Variable_Declaration => if not Get_Instance_Const (Syn_Inst) then declare - Val : constant Value_Acc := Get_Value (Syn_Inst, Decl); + Vt : constant Valtyp := Get_Value (Syn_Inst, Decl); begin - Free_Wire (Val.W); + Free_Wire (Vt.Val.W); end; end if; when Iir_Kind_Constant_Declaration => diff --git a/src/synth/synth-disp_vhdl.adb b/src/synth/synth-disp_vhdl.adb index c60a65e59..436ba938a 100644 --- a/src/synth/synth-disp_vhdl.adb +++ b/src/synth/synth-disp_vhdl.adb @@ -230,7 +230,7 @@ package body Synth.Disp_Vhdl is Port_Name : constant String := Name_Table.Image (Get_Identifier (Port)); Port_Type : constant Node := Get_Type (Port); - Typ : constant Type_Acc := Get_Value_Type (Inst, Port_Type); + Typ : constant Type_Acc := Get_Subtype_Object (Inst, Port_Type); begin Disp_In_Converter (Port_Name, Port_Name, 0, Port_Type, Typ, True); end Disp_Input_Port_Converter; @@ -386,7 +386,7 @@ package body Synth.Disp_Vhdl is Port_Name : constant String := Name_Table.Image (Get_Identifier (Port)); Port_Type : constant Node := Get_Type (Port); - Typ : constant Type_Acc := Get_Value_Type (Inst, Port_Type); + Typ : constant Type_Acc := Get_Subtype_Object (Inst, Port_Type); begin Disp_Out_Converter (Port_Name, Port_Name, 0, Port_Type, Typ, True); end Disp_Output_Port_Converter; diff --git a/src/synth/synth-expr.adb b/src/synth/synth-expr.adb index 55d89fbb9..7dd30ba46 100644 --- a/src/synth/synth-expr.adb +++ b/src/synth/synth-expr.adb @@ -48,7 +48,7 @@ with Grt.To_Strings; package body Synth.Expr is function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) - return Value_Acc; + return Valtyp; procedure Set_Location (N : Net; Loc : Node) renames Synth.Source.Set_Location; @@ -72,6 +72,11 @@ package body Synth.Expr is return Get_Net_Int64 (N); end Get_Static_Discrete; + function Get_Static_Discrete (V : Valtyp) return Int64 is + begin + return Get_Static_Discrete (V.Val); + end Get_Static_Discrete; + function Is_Positive (V : Value_Acc) return Boolean is N : Net; @@ -224,19 +229,21 @@ package body Synth.Expr is end Value2logvec; -- Resize for a discrete value. - function Synth_Resize (Val : Value_Acc; W : Width; Loc : Node) return Net + function Synth_Resize (Val : Valtyp; W : Width; Loc : Node) return Net is Wn : constant Width := Val.Typ.W; N : Net; Res : Net; begin - if Is_Static (Val) then + if Is_Static (Val.Val) then if Wn /= W then - pragma Assert (Val.Kind = Value_Discrete); + pragma Assert (Val.Val.Kind = Value_Discrete); if Val.Typ.Drange.Is_Signed then - Res := Build2_Const_Int (Build_Context, Val.Scal, W); + Res := Build2_Const_Int + (Build_Context, Val.Val.Scal, W); else - Res := Build2_Const_Uns (Build_Context, To_Uns64 (Val.Scal), W); + Res := Build2_Const_Uns + (Build_Context, To_Uns64 (Val.Val.Scal), W); end if; Set_Location (Res, Loc); return Res; @@ -367,13 +374,13 @@ package body Synth.Expr is procedure Set_Elem (Pos : Iir_Index32) is Sub_Const : Boolean; - Val : Value_Acc; + Val : Valtyp; begin if Dim = Strides'Last then Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Typ); pragma Assert (Res.V (Pos) = null); - Res.V (Pos) := Val; - if Const_P and then not Is_Static (Val) then + Res.V (Pos) := Val.Val; + if Const_P and then not Is_Static (Val.Val) then Const_P := False; end if; else @@ -386,24 +393,24 @@ package body Synth.Expr is end Set_Elem; procedure Set_Vector - (Pos : Iir_Index32; Len : Iir_Index32; Val : Value_Acc) is + (Pos : Iir_Index32; Len : Iir_Index32; Val : Valtyp) is begin pragma Assert (Dim = Strides'Last); if Len = 0 then return; end if; -- FIXME: factorize with bit_extract ? - case Val.Kind is + case Val.Val.Kind is when Value_Array | Value_Const_Array => declare E : Value_Acc; begin for I in 1 .. Len loop - E := Val.Arr.V (I); + E := Val.Val.Arr.V (I); Res.V (Pos + I - 1) := E; end loop; - Const_P := Const_P and then Val.Kind = Value_Const_Array; + Const_P := Const_P and then Val.Val.Kind = Value_Const_Array; end; when Value_Net | Value_Wire => @@ -444,7 +451,7 @@ package body Synth.Expr is end if; else declare - Val : Value_Acc; + Val : Valtyp; Val_Len : Uns32; begin Val := Synth_Expression_With_Basetype @@ -478,14 +485,15 @@ package body Synth.Expr is pragma Assert (Get_Element_Type_Flag (Assoc)); declare Ch : constant Node := Get_Choice_Expression (Assoc); - Idx : Value_Acc; + Idx : Valtyp; Off : Iir_Index32; begin Idx := Synth_Expression (Syn_Inst, Ch); - if not Is_Static (Idx) then + if not Is_Static (Idx.Val) then Error_Msg_Synth (+Ch, "choice is not static"); else - Off := Iir_Index32 (Get_Index_Offset (Idx, Bound, Ch)); + Off := Iir_Index32 + (Get_Index_Offset (Idx.Val, Bound, Ch)); Set_Elem (First_Pos + Off * Stride); end if; end; @@ -493,7 +501,7 @@ package body Synth.Expr is declare Ch : constant Node := Get_Choice_Range (Assoc); Rng : Discrete_Range_Type; - Val : Value_Acc; + Val : Valtyp; Rng_Len : Width; Off : Iir_Index32; begin @@ -501,13 +509,13 @@ package body Synth.Expr is if Get_Element_Type_Flag (Assoc) then Val := Create_Value_Discrete (Rng.Left, - Get_Value_Type (Syn_Inst, - Get_Base_Type (Get_Type (Ch)))); - while In_Range (Rng, Val.Scal) loop + Get_Subtype_Object (Syn_Inst, + Get_Base_Type (Get_Type (Ch)))); + while In_Range (Rng, Val.Val.Scal) loop Off := Iir_Index32 - (Get_Index_Offset (Val, Bound, Ch)); + (Get_Index_Offset (Val.Val, Bound, Ch)); Set_Elem (First_Pos + Off * Stride); - Update_Index (Rng, Val.Scal); + Update_Index (Rng, Val.Val.Scal); end loop; else -- The direction must be the same. @@ -556,17 +564,17 @@ package body Synth.Expr is procedure Set_Elem (Pos : Natural) is - Val : Value_Acc; + Val : Valtyp; El_Type : Type_Acc; begin - El_Type := Get_Value_Type + El_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Get_Nth_Element (El_List, Pos))); Val := Synth_Expression_With_Type (Syn_Inst, Value, El_Type); - Rec.V (Iir_Index32 (Pos + 1)) := Synth_Subtype_Conversion - (Val, El_Type, False, Value); - if Const_P and not Is_Static (Val) then + if Const_P and not Is_Static (Val.Val) then Const_P := False; end if; + Val := Synth_Subtype_Conversion (Val, El_Type, False, Value); + Rec.V (Iir_Index32 (Pos + 1)) := Val.Val; end Set_Elem; begin Assoc := Get_Association_Choices_Chain (Aggr); @@ -655,32 +663,32 @@ package body Synth.Expr is function Synth_Discrete_Range_Expression (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type is - L, R : Value_Acc; + L, R : Valtyp; begin 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) and Is_Static (R)) then + if not (Is_Static (L.Val) and Is_Static (R.Val)) then Error_Msg_Synth (+Rng, "limits of range are not constant"); raise Internal_Error; end if; return (Dir => Get_Direction (Rng), - Left => L.Scal, - Right => R.Scal, - Is_Signed => L.Scal < 0 or R.Scal < 0); + Left => L.Val.Scal, + Right => R.Val.Scal, + Is_Signed => L.Val.Scal < 0 or R.Val.Scal < 0); end Synth_Discrete_Range_Expression; function Synth_Float_Range_Expression (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type is - L, R : Value_Acc; + L, R : Valtyp; begin L := Synth_Expression (Syn_Inst, Get_Left_Limit (Rng)); R := Synth_Expression (Syn_Inst, Get_Right_Limit (Rng)); - return ((Get_Direction (Rng), L.Fp, R.Fp)); + return ((Get_Direction (Rng), L.Val.Fp, R.Val.Fp)); end Synth_Float_Range_Expression; -- Return the type of EXPR without evaluating it. @@ -690,7 +698,7 @@ package body Synth.Expr is case Get_Kind (Expr) is when Iir_Kinds_Object_Declaration => declare - Val : constant Value_Acc := Get_Value (Syn_Inst, Expr); + Val : constant Valtyp := Get_Value (Syn_Inst, Expr); begin return Val.Typ; end; @@ -736,12 +744,13 @@ package body Synth.Expr is when Iir_Kind_Implicit_Dereference | Iir_Kind_Dereference => declare - Val : Value_Acc; + Val : Valtyp; + Res : Valtyp; begin -- Maybe do not dereference it if its type is known ? Val := Synth_Expression (Syn_Inst, Get_Prefix (Expr)); - Val := Heap.Synth_Dereference (Val.Acc); - return Val.Typ; + Res := Heap.Synth_Dereference (Val.Val.Acc); + return Res.Typ; end; when others => @@ -761,7 +770,7 @@ package body Synth.Expr is -- 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_Value_Type (Syn_Inst, Get_Subtype_Indication (Prefix)); + Typ := Get_Subtype_Object (Syn_Inst, Get_Subtype_Indication (Prefix)); else Typ := Synth_Type_Of_Object (Syn_Inst, Prefix); end if; @@ -783,7 +792,7 @@ package body Synth.Expr is Typ : Type_Acc; begin -- This is a named subtype, so it has been evaluated. - Typ := Get_Value_Type (Syn_Inst, Bound); + Typ := Get_Subtype_Object (Syn_Inst, Bound); Rng := Typ.Drange; end; else @@ -843,14 +852,14 @@ package body Synth.Expr is end; else declare - Bnds : constant Value_Acc := Get_Value (Syn_Inst, Atype); + Bnds : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Atype); begin - case Bnds.Typ.Kind is + case Bnds.Kind is when Type_Vector => pragma Assert (Dim = 1); - return Bnds.Typ.Vbound; + return Bnds.Vbound; when Type_Array => - return Bnds.Typ.Abounds.D (Dim); + return Bnds.Abounds.D (Dim); when others => raise Internal_Error; end case; @@ -871,11 +880,11 @@ package body Synth.Expr is function Synth_Aggregate_Array (Syn_Inst : Synth_Instance_Acc; Aggr : Node; - Aggr_Type : Type_Acc) return Value_Acc + Aggr_Type : Type_Acc) return Valtyp is Strides : constant Stride_Array := Fill_Stride (Aggr_Type); Arr : Value_Array_Acc; - Res : Value_Acc; + Res : Valtyp; Const_P : Boolean; begin Arr := Create_Value_Array @@ -895,10 +904,10 @@ package body Synth.Expr is function Synth_Aggregate_Record (Syn_Inst : Synth_Instance_Acc; Aggr : Node; - Aggr_Type : Type_Acc) return Value_Acc + Aggr_Type : Type_Acc) return Valtyp is Arr : Value_Array_Acc; - Res : Value_Acc; + Res : Valtyp; Const_P : Boolean; begin -- Allocate the result. @@ -918,7 +927,7 @@ package body Synth.Expr is -- Aggr_Type is the type from the context. function Synth_Aggregate (Syn_Inst : Synth_Instance_Acc; Aggr : Node; - Aggr_Type : Type_Acc) return Value_Acc is + Aggr_Type : Type_Acc) return Valtyp is begin case Aggr_Type.Kind is when Type_Unbounded_Array | Type_Unbounded_Vector => @@ -939,19 +948,19 @@ package body Synth.Expr is end Synth_Aggregate; function Synth_Simple_Aggregate (Syn_Inst : Synth_Instance_Acc; - Aggr : Node) return Value_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_Value_Type (Syn_Inst, El_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; Arr : Value_Array_Acc; - Val : Value_Acc; + Val : Valtyp; begin -- Allocate the result. Bnd := Synth_Array_Bounds (Syn_Inst, Aggr_Type, 1); @@ -970,50 +979,49 @@ package body Synth.Expr is for I in Flist_First .. Last loop Val := Synth_Expression_With_Type (Syn_Inst, Get_Nth_Element (Els, I), El_Typ); - pragma Assert (Is_Static (Val)); - Arr.V (Iir_Index32 (I + 1)) := Val; + pragma Assert (Is_Static (Val.Val)); + Arr.V (Iir_Index32 (I + 1)) := Val.Val; end loop; return Create_Value_Const_Array (Res_Type, Arr); end Synth_Simple_Aggregate; -- Change the bounds of VAL. - function Reshape_Value (Val : Value_Acc; Ntype : Type_Acc) - return Value_Acc is + function Reshape_Value (Val : Valtyp; Ntype : Type_Acc) return Valtyp is begin - case Val.Kind is + case Val.Val.Kind is when Value_Array => - return Create_Value_Array (Ntype, Val.Arr); + return Create_Value_Array (Ntype, Val.Val.Arr); when Value_Const_Array => - return Create_Value_Const_Array (Ntype, Val.Arr); + return Create_Value_Const_Array (Ntype, Val.Val.Arr); when Value_Wire => - return Create_Value_Wire (Val.W, Ntype); + return Create_Value_Wire (Val.Val.W, Ntype); when Value_Net => - return Create_Value_Net (Val.N, Ntype); + return Create_Value_Net (Val.Val.N, Ntype); when Value_Alias => - return Create_Value_Alias (Val.A_Obj, Val.A_Off, Ntype); + return Create_Value_Alias (Val.Val.A_Obj, Val.Val.A_Off, Ntype); when Value_Const => - return Reshape_Value (Val.C_Val, Ntype); + return Reshape_Value ((Val.Typ, Val.Val.C_Val), Ntype); when others => raise Internal_Error; end case; end Reshape_Value; - function Synth_Subtype_Conversion (Val : Value_Acc; + function Synth_Subtype_Conversion (Vt : Valtyp; Dtype : Type_Acc; Bounds : Boolean; Loc : Source.Syn_Src) - return Value_Acc + return Valtyp is - Vtype : constant Type_Acc := Val.Typ; + Vtype : constant Type_Acc := Vt.Typ; begin case Dtype.Kind is when Type_Bit => pragma Assert (Vtype.Kind = Type_Bit); - return Val; + return Vt; when Type_Logic => pragma Assert (Vtype.Kind = Type_Logic); - return Val; + return Vt; when Type_Discrete => pragma Assert (Vtype.Kind = Type_Discrete); declare @@ -1022,11 +1030,11 @@ package body Synth.Expr is if Vtype.W /= Dtype.W then -- Truncate. -- TODO: check overflow. - case Val.Kind is + case Vt.Val.Kind is when Value_Net | Value_Wire | Value_Alias => - N := Get_Net (Val); + N := Get_Net (Vt); if Vtype.Drange.Is_Signed then N := Build2_Sresize (Build_Context, N, Dtype.W, Get_Location (Loc)); @@ -1036,22 +1044,22 @@ package body Synth.Expr is end if; return Create_Value_Net (N, Dtype); when Value_Discrete => - return Create_Value_Discrete (Val.Scal, Dtype); + return Create_Value_Discrete (Vt.Val.Scal, Dtype); when Value_Const => return Synth_Subtype_Conversion - (Val.C_Val, Dtype, Bounds, Loc); + ((Vt.Typ, Vt.Val.C_Val), Dtype, Bounds, Loc); when others => raise Internal_Error; end case; else -- TODO: check overflow if sign differ. - return Val; + return Vt; end if; end; when Type_Float => pragma Assert (Vtype.Kind = Type_Float); -- TODO: check range - return Val; + return Vt; when Type_Vector => pragma Assert (Vtype.Kind = Type_Vector or Vtype.Kind = Type_Slice); @@ -1060,61 +1068,61 @@ package body Synth.Expr is raise Internal_Error; end if; if Bounds then - return Reshape_Value (Val, Dtype); + return Reshape_Value (Vt, Dtype); else - return Val; + return Vt; end if; when Type_Slice => -- TODO: check width - return Val; + return Vt; when Type_Array => pragma Assert (Vtype.Kind = Type_Array); -- TODO: check bounds, handle elements if Bounds then - return Reshape_Value (Val, Dtype); + return Reshape_Value (Vt, Dtype); else - return Val; + return Vt; end if; when Type_Unbounded_Array => pragma Assert (Vtype.Kind = Type_Array); - return Val; + return Vt; when Type_Unbounded_Vector => pragma Assert (Vtype.Kind = Type_Vector or else Vtype.Kind = Type_Slice); - return Val; + return Vt; when Type_Record => -- TODO: handle elements. - return Val; + return Vt; when Type_Access => - return Val; + return Vt; when Type_File => pragma Assert (Vtype = Dtype); - return Val; + return Vt; end case; end Synth_Subtype_Conversion; function Synth_Value_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Value_Acc + return Valtyp is Param : constant Node := Get_Parameter (Attr); Etype : constant Node := Get_Type (Attr); Btype : constant Node := Get_Base_Type (Etype); - V : Value_Acc; + V : Valtyp; Dtype : Type_Acc; begin V := Synth_Expression (Syn_Inst, Param); - if V = null then - return null; + if V = No_Valtyp then + return No_Valtyp; end if; - Dtype := Get_Value_Type (Syn_Inst, Etype); - if not Is_Static (V) then + 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 null; + return No_Valtyp; end if; declare - Str : constant String := Value_To_String (V); + Str : constant String := Value_To_String (V.Val); Res_N : Node; Val : Int64; begin @@ -1127,13 +1135,13 @@ package body Synth.Expr is Val := Int64'Value (Str); when others => Error_Msg_Synth (+Attr, "unhandled type for 'value"); - return null; + return No_Valtyp; end case; return Create_Value_Discrete (Val, Dtype); end; end Synth_Value_Attribute; - function Synth_Image_Attribute_Str (Val : Value_Acc; Expr_Type : Iir) + function Synth_Image_Attribute_Str (Val : Valtyp; Expr_Type : Iir) return String is use Grt.Types; @@ -1145,7 +1153,7 @@ package body Synth.Expr is Str : String (1 .. 24); Last : Natural; begin - Grt.To_Strings.To_String (Str, Last, Ghdl_F64 (Val.Fp)); + Grt.To_Strings.To_String (Str, Last, Ghdl_F64 (Val.Val.Fp)); return Str (Str'First .. Last); end; when Iir_Kind_Integer_Type_Definition @@ -1154,7 +1162,7 @@ package body Synth.Expr is Str : String (1 .. 21); First : Natural; begin - Grt.To_Strings.To_String (Str, First, Ghdl_I64 (Val.Scal)); + Grt.To_Strings.To_String (Str, First, Ghdl_I64 (Val.Val.Scal)); return Str (First .. Str'Last); end; when Iir_Kind_Enumeration_Type_Definition @@ -1164,7 +1172,8 @@ package body Synth.Expr is Get_Enumeration_Literal_List (Get_Base_Type (Expr_Type)); begin return Name_Table.Image - (Get_Identifier (Get_Nth_Element (Lits, Natural (Val.Scal)))); + (Get_Identifier + (Get_Nth_Element (Lits, Natural (Val.Val.Scal)))); end; when Iir_Kind_Physical_Type_Definition | Iir_Kind_Physical_Subtype_Definition => @@ -1174,7 +1183,7 @@ package body Synth.Expr is Id : constant Name_Id := Get_Identifier (Get_Primary_Unit (Get_Base_Type (Expr_Type))); begin - Grt.To_Strings.To_String (Str, First, Ghdl_I64 (Val.Scal)); + Grt.To_Strings.To_String (Str, First, Ghdl_I64 (Val.Val.Scal)); return Str (First .. Str'Last) & ' ' & Name_Table.Image (Id); end; when others => @@ -1182,8 +1191,7 @@ package body Synth.Expr is end case; end Synth_Image_Attribute_Str; - function String_To_Value_Acc (Str : String; Styp : Type_Acc) - return Value_Acc + function String_To_Valtyp (Str : String; Styp : Type_Acc) return Valtyp is Len : constant Natural := Str'Length; Etyp : constant Type_Acc := Styp.Uarr_El; @@ -1205,33 +1213,33 @@ package body Synth.Expr is P := P + 1; end loop; return Create_Value_Const_Array (Typ, Dat); - end String_To_Value_Acc; + end String_To_Valtyp; function Synth_Image_Attribute (Syn_Inst : Synth_Instance_Acc; Attr : Node) - return Value_Acc + return Valtyp is Param : constant Node := Get_Parameter (Attr); Etype : constant Node := Get_Type (Attr); - V : Value_Acc; + V : Valtyp; Dtype : Type_Acc; begin V := Synth_Expression (Syn_Inst, Param); - if V = null then - return null; + if V = No_Valtyp then + return No_Valtyp; end if; - Dtype := Get_Value_Type (Syn_Inst, Etype); - if not Is_Static (V) then + 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 null; + return No_Valtyp; end if; Strip_Const (V); - return String_To_Value_Acc + return String_To_Valtyp (Synth_Image_Attribute_Str (V, Get_Type (Param)), Dtype); end Synth_Image_Attribute; function Synth_Name (Syn_Inst : Synth_Instance_Acc; Name : Node) - return Value_Acc is + return Valtyp is begin case Get_Kind (Name) is when Iir_Kind_Simple_Name @@ -1249,20 +1257,28 @@ package body Synth.Expr is | Iir_Kind_Interface_File_Declaration => return Get_Value (Syn_Inst, Name); when Iir_Kind_Enumeration_Literal => - return Create_Value_Discrete - (Int64 (Get_Enum_Pos (Name)), - Get_Value_Type (Syn_Inst, Get_Type (Name))); + declare + Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Name)); + begin + return (Typ, Create_Value_Discrete + (Int64 (Get_Enum_Pos (Name)), Typ)); + end; when Iir_Kind_Unit_Declaration => - return Create_Value_Discrete - (Vhdl.Evaluation.Get_Physical_Value (Name), - Get_Value_Type (Syn_Inst, Get_Type (Name))); + declare + Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Get_Type (Name)); + begin + return (Typ, Create_Value_Discrete + (Vhdl.Evaluation.Get_Physical_Value (Name), Typ)); + end; when Iir_Kind_Implicit_Dereference | Iir_Kind_Dereference => declare - Val : Value_Acc; + Val : Valtyp; begin Val := Synth_Expression (Syn_Inst, Get_Prefix (Name)); - return Heap.Synth_Dereference (Val.Acc); + return Heap.Synth_Dereference (Val.Val.Acc); end; when others => Error_Kind ("synth_name", Name); @@ -1301,7 +1317,7 @@ package body Synth.Expr is end Index_To_Offset; function Dyn_Index_To_Offset - (Bnd : Bound_Type; Idx_Val : Value_Acc; Loc : Node) return Net + (Bnd : Bound_Type; Idx_Val : Valtyp; Loc : Node) return Net is Idx2 : Net; Off : Net; @@ -1386,7 +1402,7 @@ package body Synth.Expr is Indexes : constant Iir_Flist := Get_Index_List (Name); El_Typ : constant Type_Acc := Get_Array_Element (Pfx_Type); Idx_Expr : Node; - Idx_Val : Value_Acc; + Idx_Val : Valtyp; Bnd : Bound_Type; Stride : Uns32; Ivoff : Net; @@ -1411,9 +1427,10 @@ package body Synth.Expr is Bnd := Get_Array_Bound (Pfx_Type, Dim_Type (I + 1)); - if Idx_Val.Kind = Value_Discrete then + if Idx_Val.Val.Kind = Value_Discrete then Off := Off - + Index_To_Offset (Syn_Inst, Bnd, Idx_Val.Scal, Name) * Stride; + + (Index_To_Offset (Syn_Inst, Bnd, Idx_Val.Val.Scal, Name) + * Stride); else Ivoff := Dyn_Index_To_Offset (Bnd, Idx_Val, Name); Ivoff := Build_Memidx (Get_Build (Syn_Inst), Ivoff, W, Bnd.Len - 1, @@ -1654,7 +1671,7 @@ package body Synth.Expr is Wd : out Width) is Expr : constant Node := Get_Suffix (Name); - Left, Right : Value_Acc; + Left, Right : Valtyp; Dir : Iir_Direction; Step : Uns32; Max : Uns32; @@ -1686,13 +1703,14 @@ package body Synth.Expr is (+Expr, "only range expression supported for slices"); end case; - if Is_Static_Val (Left) and then Is_Static_Val (Right) then + if Is_Static_Val (Left.Val) and then Is_Static_Val (Right.Val) then Inp := No_Net; - Synth_Slice_Const_Suffix - (Syn_Inst, Expr, - Name, Pfx_Bnd, - Get_Static_Discrete (Left), Get_Static_Discrete (Right), Dir, - El_Wd, Res_Bnd, Off, Wd); + Synth_Slice_Const_Suffix (Syn_Inst, Expr, + Name, Pfx_Bnd, + Get_Static_Discrete (Left.Val), + Get_Static_Discrete (Right.Val), + Dir, + El_Wd, Res_Bnd, Off, Wd); else if Pfx_Bnd.Dir /= Dir then Error_Msg_Synth (+Name, "direction mismatch in slice"); @@ -1707,7 +1725,7 @@ package body Synth.Expr is return; end if; - if Is_Static (Left) or else Is_Static (Right) then + 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"); @@ -1770,7 +1788,7 @@ package body Synth.Expr is Lit : Node; Posedge : Boolean; begin - Clk := Get_Net (Synth_Name (Syn_Inst, Prefix)); + Clk := Get_Net (Synth_Name (Syn_Inst, Prefix).Val); if Get_Kind (Expr) /= Iir_Kind_Equality_Operator then Error_Msg_Synth (+Expr, "ill-formed clock-level, '=' expected"); return Build_Edge (Build_Context, Clk); @@ -1835,16 +1853,16 @@ package body Synth.Expr is end Synth_Clock_Edge; function Synth_Type_Conversion (Syn_Inst : Synth_Instance_Acc; Conv : Node) - return Value_Acc + return Valtyp is Expr : constant Node := Get_Expression (Conv); Conv_Type : constant Node := Get_Type (Conv); - Conv_Typ : constant Type_Acc := Get_Value_Type (Syn_Inst, Conv_Type); - Val : Value_Acc; + 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 = null then - return null; + if Val = No_Valtyp then + return No_Valtyp; end if; Strip_Const (Val); case Get_Kind (Conv_Type) is @@ -1853,17 +1871,17 @@ package body Synth.Expr is -- Int to int. return Val; elsif Val.Typ.Kind = Type_Float then - return Create_Value_Discrete (Int64 (Val.Fp), Conv_Typ); + return Create_Value_Discrete (Int64 (Val.Val.Fp), Conv_Typ); else Error_Msg_Synth (+Conv, "unhandled type conversion (to int)"); - return null; + return No_Valtyp; end if; when Iir_Kind_Floating_Subtype_Definition => - if Is_Static (Val) then - return Create_Value_Float (Fp64 (Val.Scal), Conv_Typ); + if Is_Static (Val.Val) then + return Create_Value_Float (Fp64 (Val.Val.Scal), Conv_Typ); else Error_Msg_Synth (+Conv, "unhandled type conversion (to float)"); - return null; + return No_Valtyp; end if; when Iir_Kind_Array_Type_Definition | Iir_Kind_Array_Subtype_Definition => @@ -1874,7 +1892,7 @@ package body Synth.Expr is when others => Error_Msg_Synth (+Conv, "unhandled type conversion (to array)"); - return null; + return No_Valtyp; end case; when Iir_Kind_Enumeration_Type_Definition | Iir_Kind_Enumeration_Subtype_Definition => @@ -1883,7 +1901,7 @@ package body Synth.Expr is return Val; when others => Error_Msg_Synth (+Conv, "unhandled type conversion"); - return null; + return No_Valtyp; end case; end Synth_Type_Conversion; @@ -1902,7 +1920,7 @@ package body Synth.Expr is function Synth_String_Literal (Syn_Inst : Synth_Instance_Acc; Str : Node; Str_Typ : Type_Acc) - return Value_Acc + return Valtyp is pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); Id : constant String8_Id := Get_String8_Id (Str); @@ -1912,7 +1930,7 @@ package body Synth.Expr is Bounds : Bound_Type; Bnds : Bound_Array_Acc; Res_Type : Type_Acc; - Res : Value_Acc; + Res : Valtyp; Arr : Value_Array_Acc; Pos : Nat8; begin @@ -1928,7 +1946,7 @@ package body Synth.Expr is raise Internal_Error; end case; - El_Type := Get_Value_Type (Syn_Inst, Get_Element_Subtype (Str_Type)); + 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 @@ -1951,12 +1969,12 @@ package body Synth.Expr is -- 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 : Iir_Direction) - return Value_Acc + return Valtyp is Typ : Type_Acc; R : Int64; begin - Typ := Get_Value_Type (Syn_Inst, Get_Type (Get_Prefix (Expr))); + 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; @@ -1973,10 +1991,10 @@ package body Synth.Expr is Left_Expr : Node; Right_Expr : Node; Typ : Type_Acc; - Expr : Node) return Value_Acc + Expr : Node) return Valtyp is - Left : Value_Acc; - Right : Value_Acc; + Left : Valtyp; + Right : Valtyp; Val : Int64; N : Net; begin @@ -1989,38 +2007,40 @@ package body Synth.Expr is end case; Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Typ); - if Left = null then - return null; + if Left = No_Valtyp then + return No_Valtyp; end if; - if Is_Static_Val (Left) and then Get_Static_Discrete (Left) = Val then + if Is_Static_Val (Left.Val) + and then Get_Static_Discrete (Left.Val) = Val + then return Create_Value_Discrete (Val, Boolean_Type); end if; Strip_Const (Left); Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Typ); - if Right = null then - return null; + if Right = No_Valtyp then + return No_Valtyp; end if; Strip_Const (Right); -- 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) and then Is_Static_Val (Right) then - Val := Get_Static_Discrete (Right); + if Is_Static_Val (Left.Val) and then Is_Static_Val (Right.Val) then + Val := Get_Static_Discrete (Right.Val); return Create_Value_Discrete (Val, Boolean_Type); end if; N := Build_Dyadic (Build_Context, Id, - Get_Net (Left), Get_Net (Right)); + Get_Net (Left.Val), Get_Net (Right.Val)); 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 Value_Acc + return Valtyp is - Res : Value_Acc; + Res : Valtyp; begin case Get_Kind (Expr) is when Iir_Kinds_Dyadic_Operator => @@ -2099,20 +2119,19 @@ package body Synth.Expr is when Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name => declare - Obj : Value_Acc; + Vt : Valtyp; Off : Uns32; - Typ : Type_Acc; Voff : Net; Rdwd : Width; begin - Synth_Assignment_Prefix (Syn_Inst, Expr, - Obj, Off, Voff, Rdwd, Typ); - if Voff = No_Net and then Is_Static (Obj) then + Synth_Assignment_Prefix (Syn_Inst, Expr, Vt, Off, Voff, Rdwd); + if Voff = No_Net and then Is_Static (Vt.Val) then pragma Assert (Off = 0); - return Obj; + return Vt; end if; - return Synth_Read_Memory (Syn_Inst, Obj, Off, Voff, Typ, Expr); + return Synth_Read_Memory + (Syn_Inst, Vt.Val, Off, Voff, Vt.Typ, Expr); end; when Iir_Kind_Selected_Element => declare @@ -2125,11 +2144,11 @@ package body Synth.Expr is Res := Synth_Expression (Syn_Inst, Pfx); Strip_Const (Res); Res_Typ := Res.Typ.Rec.E (Idx + 1).Typ; - if Res.Kind = Value_Const_Record then - return Res.Rec.V (Idx + 1); + if Res.Val.Kind = Value_Const_Record then + return (Res_Typ, Res.Val.Rec.V (Idx + 1)); else N := Build_Extract - (Build_Context, Get_Net (Res), + (Build_Context, Get_Net (Res.Val), Res.Typ.Rec.E (Idx + 1).Off, Get_Type_Width (Res_Typ)); Set_Location (N, Expr); return Create_Value_Net (N, Res_Typ); @@ -2155,7 +2174,7 @@ package body Synth.Expr is when Iir_Kind_Qualified_Expression => return Synth_Expression_With_Type (Syn_Inst, Get_Expression (Expr), - Get_Value_Type (Syn_Inst, Get_Type (Get_Type_Mark (Expr)))); + Get_Subtype_Object (Syn_Inst, Get_Type (Get_Type_Mark (Expr)))); when Iir_Kind_Function_Call => declare Imp : constant Node := Get_Implementation (Expr); @@ -2226,11 +2245,11 @@ package body Synth.Expr is | Iir_Kind_Val_Attribute => declare Param : constant Node := Get_Parameter (Expr); - V : Value_Acc; + V : Valtyp; Dtype : Type_Acc; begin V := Synth_Expression (Syn_Inst, Param); - Dtype := Get_Value_Type (Syn_Inst, Get_Type (Expr)); + 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 (V, Dtype, False, Expr); @@ -2257,7 +2276,7 @@ package body Synth.Expr is end; when Iir_Kind_Allocator_By_Expression => declare - V : Value_Acc; + V : Valtyp; Acc : Heap_Index; begin V := Synth_Expression_With_Type @@ -2280,18 +2299,19 @@ package body Synth.Expr is end Synth_Expression_With_Type; function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) - return Value_Acc is + return Valtyp is begin return Synth_Expression_With_Type - (Syn_Inst, Expr, Get_Value_Type (Syn_Inst, Get_Type (Expr))); + (Syn_Inst, Expr, Get_Subtype_Object (Syn_Inst, Get_Type (Expr))); end Synth_Expression; function Synth_Expression_With_Basetype - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is Basetype : Type_Acc; begin - Basetype := Get_Value_Type (Syn_Inst, Get_Base_Type (Get_Type (Expr))); + 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; diff --git a/src/synth/synth-expr.ads b/src/synth/synth-expr.ads index 35c1acc0e..ff713ff6a 100644 --- a/src/synth/synth-expr.ads +++ b/src/synth/synth-expr.ads @@ -32,14 +32,15 @@ with Vhdl.Nodes; use Vhdl.Nodes; package Synth.Expr is -- Perform a subtype conversion. Check constraints. - function Synth_Subtype_Conversion (Val : Value_Acc; + function Synth_Subtype_Conversion (Vt : Valtyp; Dtype : Type_Acc; Bounds : Boolean; Loc : Source.Syn_Src) - return Value_Acc; + return Valtyp; -- For a static value V, return the value. function Get_Static_Discrete (V : Value_Acc) return Int64; + function Get_Static_Discrete (V : Valtyp) return Int64; -- Return True only if discrete value V is known to be positive or 0. -- False means either not positive or unknown. @@ -69,15 +70,15 @@ package Synth.Expr is function Synth_Expression_With_Type (Syn_Inst : Synth_Instance_Acc; Expr : Node; Expr_Type : Type_Acc) - return Value_Acc; + return Valtyp; function Synth_Expression (Syn_Inst : Synth_Instance_Acc; Expr : Node) - return Value_Acc; + return Valtyp; -- Use base type of EXPR to synthesize EXPR. Useful when the type of -- EXPR is defined by itself or a range. function Synth_Expression_With_Basetype - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; function Synth_Bounds_From_Range (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Bound_Type; diff --git a/src/synth/synth-files_operations.adb b/src/synth/synth-files_operations.adb index 5c8b6b153..f5f996a6e 100644 --- a/src/synth/synth-files_operations.adb +++ b/src/synth/synth-files_operations.adb @@ -61,12 +61,12 @@ package body Synth.Files_Operations is end Convert_String; -- Convert filename VAL to RES + LEN. - procedure Convert_File_Name (Val : Value_Acc; + procedure Convert_File_Name (Val : Valtyp; Res : out C_File_Name; Len : out Natural; Status : out Op_Status) is - Name : constant Value_Acc := Strip_Alias_Const (Val); + Name : constant Value_Acc := Strip_Alias_Const (Val.Val); pragma Unreferenced (Val); begin Len := Natural (Name.Arr.Len); @@ -88,10 +88,10 @@ package body Synth.Files_Operations is File_Type : constant Node := Get_Type (Decl); External_Name : constant Node := Get_File_Logical_Name (Decl); Open_Kind : constant Node := Get_File_Open_Kind (Decl); - File_Name : Value_Acc; + File_Name : Valtyp; C_Name : C_File_Name; C_Name_Len : Natural; - Mode : Value_Acc; + Mode : Valtyp; F : File_Index; File_Mode : Ghdl_I32; Status : Op_Status; @@ -125,7 +125,7 @@ package body Synth.Files_Operations is if Open_Kind /= Null_Node then Mode := Synth_Expression (Syn_Inst, Open_Kind); - File_Mode := Ghdl_I32 (Mode.Scal); + File_Mode := Ghdl_I32 (Mode.Val.Scal); else case Get_Mode (Decl) is when Iir_In_Mode => @@ -184,11 +184,11 @@ package body Synth.Files_Operations is (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) is Inters : constant Node := Get_Interface_Declaration_Chain (Imp); - F : constant File_Index := Get_Value (Syn_Inst, Inters).File; + F : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; Param2 : constant Node := Get_Chain (Inters); - File_Name : constant Value_Acc := Get_Value (Syn_Inst, Param2); + File_Name : constant Valtyp := Get_Value (Syn_Inst, Param2); Param3 : constant Node := Get_Chain (Param2); - Open_Kind : constant Value_Acc := Get_Value (Syn_Inst, Param3); + Open_Kind : constant Valtyp := Get_Value (Syn_Inst, Param3); C_Name : C_File_Name; C_Name_Len : Natural; File_Mode : Ghdl_I32; @@ -196,7 +196,7 @@ package body Synth.Files_Operations is begin Convert_File_Name (File_Name, C_Name, C_Name_Len, Status); if Status = Op_Ok then - File_Mode := Ghdl_I32 (Open_Kind.Scal); + File_Mode := Ghdl_I32 (Open_Kind.Val.Scal); if Get_Text_File_Flag (Get_Type (Inters)) then Ghdl_Text_File_Open (F, File_Mode, To_Ghdl_C_String (C_Name'Address), Status); @@ -223,7 +223,7 @@ package body Synth.Files_Operations is (Syn_Inst : Synth_Instance_Acc; Imp : Node; Loc : Node) is Inters : constant Node := Get_Interface_Declaration_Chain (Imp); - F : constant File_Index := Get_Value (Syn_Inst, Inters).File; + F : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; Status : Op_Status; begin if Get_Text_File_Flag (Get_Type (Inters)) then @@ -245,12 +245,12 @@ package body Synth.Files_Operations is Loc : Node) is Inters : constant Node := Get_Interface_Declaration_Chain (Imp); - File : constant File_Index := Get_Value (Syn_Inst, Inters).File; + File : constant File_Index := Get_Value (Syn_Inst, Inters).Val.File; Param2 : constant Node := Get_Chain (Inters); - Str : constant Value_Acc := Get_Value (Syn_Inst, Param2); + Str : constant Valtyp := Get_Value (Syn_Inst, Param2); Param3 : constant Node := Get_Chain (Param2); - Param_Len : constant Value_Acc := Get_Value (Syn_Inst, Param3); - Buf : String (1 .. Natural (Str.Arr.Len)); + Param_Len : constant Valtyp := Get_Value (Syn_Inst, Param3); + Buf : String (1 .. Natural (Str.Val.Arr.Len)); Len : Std_Integer; Status : Op_Status; begin @@ -262,10 +262,10 @@ package body Synth.Files_Operations is end if; for I in 1 .. Natural (Len) loop - Str.Arr.V (Iir_Index32 (I)).Scal := Character'Pos (Buf (I)); + Str.Val.Arr.V (Iir_Index32 (I)).Scal := Character'Pos (Buf (I)); end loop; - Param_Len.Scal := Int64 (Len); + Param_Len.Val.Scal := Int64 (Len); end Synth_Untruncated_Text_Read; end Synth.Files_Operations; diff --git a/src/synth/synth-heap.adb b/src/synth/synth-heap.adb index 27d5fb787..8db5b77de 100644 --- a/src/synth/synth-heap.adb +++ b/src/synth/synth-heap.adb @@ -26,7 +26,7 @@ with Vhdl.Nodes; use Vhdl.Nodes; package body Synth.Heap is package Heap_Table is new Tables - (Table_Component_Type => Value_Acc, + (Table_Component_Type => Valtyp, Table_Index_Type => Heap_Index, Table_Low_Bound => 1, Table_Initial => 16); @@ -62,27 +62,29 @@ package body Synth.Heap is function Allocate_By_Type (T : Type_Acc) return Heap_Index is begin -- FIXME: allocate type. - Heap_Table.Append (Allocate_By_Type (T)); + Heap_Table.Append ((T, Allocate_By_Type (T))); return Heap_Table.Last; end Allocate_By_Type; - function Allocate_By_Value (V : Value_Acc) return Value_Acc is + function Allocate_By_Value (V : Valtyp) return Value_Acc is begin - case V.Kind is + case V.Val.Kind is when Value_Net | Value_Wire => raise Internal_Error; when Value_Discrete => return new Value_Type' - (Kind => Value_Discrete, Typ => V.Typ, Scal => V.Scal); + (Kind => Value_Discrete, Typ => V.Typ, Scal => V.Val.Scal); when Value_Array | Value_Const_Array => declare + El_Typ : constant Type_Acc := Get_Array_Element (V.Typ); Arr : Value_Array_Acc; begin - Arr := new Value_Array_Type (V.Arr.Len); + Arr := new Value_Array_Type (V.Val.Arr.Len); for I in Arr.V'Range loop - Arr.V (I) := Allocate_By_Value (V.Arr.V (I)); + Arr.V (I) := Allocate_By_Value + ((El_Typ, V.Val.Arr.V (I))); end loop; return new Value_Type' (Kind => Value_Const_Array, Typ => V.Typ, Arr => Arr); @@ -92,26 +94,26 @@ package body Synth.Heap is end case; end Allocate_By_Value; - function Allocate_By_Value (V : Value_Acc) return Heap_Index is + function Allocate_By_Value (V : Valtyp) return Heap_Index is begin - Heap_Table.Append (Allocate_By_Value (V)); + Heap_Table.Append ((V.Typ, Allocate_By_Value (V))); return Heap_Table.Last; end Allocate_By_Value; - function Synth_Dereference (Idx : Heap_Index) return Value_Acc is + function Synth_Dereference (Idx : Heap_Index) return Valtyp is begin return Heap_Table.Table (Idx); end Synth_Dereference; - procedure Free (Obj : in out Value_Acc) is + procedure Free (Obj : in out Valtyp) is begin -- TODO - Obj := null; + Obj := No_Valtyp; end Free; procedure Synth_Deallocate (Idx : Heap_Index) is begin - if Heap_Table.Table (Idx) = null then + if Heap_Table.Table (Idx) = No_Valtyp then return; end if; Free (Heap_Table.Table (Idx)); diff --git a/src/synth/synth-heap.ads b/src/synth/synth-heap.ads index 5568a3772..204ff3846 100644 --- a/src/synth/synth-heap.ads +++ b/src/synth/synth-heap.ads @@ -23,9 +23,9 @@ with Synth.Values; use Synth.Values; package Synth.Heap is -- Allocate a value. function Allocate_By_Type (T : Type_Acc) return Heap_Index; - function Allocate_By_Value (V : Value_Acc) return Heap_Index; + function Allocate_By_Value (V : Valtyp) return Heap_Index; - function Synth_Dereference (Idx : Heap_Index) return Value_Acc; + function Synth_Dereference (Idx : Heap_Index) return Valtyp; procedure Synth_Deallocate (Idx : Heap_Index); end Synth.Heap; diff --git a/src/synth/synth-insts.adb b/src/synth/synth-insts.adb index 28c3a2dbb..824fa63bb 100644 --- a/src/synth/synth-insts.adb +++ b/src/synth/synth-insts.adb @@ -118,8 +118,8 @@ package body Synth.Insts is end if; Inter := Get_Generic_Chain (Params.Decl); while Inter /= Null_Node loop - if not Is_Equal (Get_Value (Obj.Syn_Inst, Inter), - Get_Value (Params.Syn_Inst, Inter)) + if not Is_Equal (Get_Value (Obj.Syn_Inst, Inter).Val, + Get_Value (Params.Syn_Inst, Inter).Val) then return False; end if; @@ -213,9 +213,7 @@ package body Synth.Insts is | Value_Array | Value_Record | Value_Access - | Value_File - | Value_Instance - | Value_Subtype => + | Value_File => raise Internal_Error; end case; end Hash_Const; @@ -262,7 +260,7 @@ package body Synth.Insts is Len : Natural; Gen_Decl : Node; - Gen : Value_Acc; + Gen : Valtyp; begin Len := Id_Len; Str (1 .. Len) := Get_Name_Ptr (Id) (1 .. Len); @@ -276,15 +274,15 @@ package body Synth.Insts is Gen_Decl := Generics; while Gen_Decl /= Null_Node loop Gen := Get_Value (Params.Syn_Inst, Gen_Decl); - case Gen.Kind is + case Gen.Val.Kind is when Value_Discrete => declare S : constant String := - Uns64'Image (To_Uns64 (Gen.Scal)); + Uns64'Image (To_Uns64 (Gen.Val.Scal)); begin if Len + S'Length > Str_Len then Has_Hash := True; - Hash_Const (Ctxt, Gen, Gen.Typ); + Hash_Const (Ctxt, Gen.Val, Gen.Typ); else Str (Len + 1 .. Len + S'Length) := S; pragma Assert (Str (Len + 1) = ' '); @@ -294,7 +292,7 @@ package body Synth.Insts is end; when others => Has_Hash := True; - Hash_Const (Ctxt, Gen, Gen.Typ); + Hash_Const (Ctxt, Gen.Val, Gen.Typ); end case; Gen_Decl := Get_Chain (Gen_Decl); end loop; @@ -396,8 +394,9 @@ package body Synth.Insts is case Get_Kind (Inter_Type) is when Iir_Kind_Array_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition => - Create_Object (Syn_Inst, Inter_Type, - Get_Value (Params.Syn_Inst, Inter_Type)); + Create_Subtype_Object + (Syn_Inst, Inter_Type, + Get_Subtype_Object (Params.Syn_Inst, Inter_Type)); when others => null; end case; @@ -416,7 +415,7 @@ package body Synth.Insts is while Is_Valid (Inter) loop -- Elaborate the type... Synth_Declaration_Type (Syn_Inst, Inter); - Inter_Typ := Get_Value_Type (Syn_Inst, Get_Type (Inter)); + Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); if not Is_Bounded_Type (Inter_Typ) then -- ... but get it from the template (so that unbounded types -- are bounded). @@ -431,7 +430,7 @@ package body Synth.Insts is Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); Nbr_Outputs := Nbr_Outputs + 1; end case; - Create_Object (Syn_Inst, Inter, Val); + Create_Object (Syn_Inst, Inter, (Inter_Typ, Val)); Inter := Get_Chain (Inter); end loop; @@ -492,18 +491,18 @@ package body Synth.Insts is Outports : Port_Desc_Array (1 .. Nbr_Outputs); Pkind : Port_Kind; Desc : Port_Desc; - Val : Value_Acc; + Vt : Valtyp; begin Inter := Get_Port_Chain (Decl); Nbr_Inputs := 0; Nbr_Outputs := 0; while Is_Valid (Inter) loop Pkind := Mode_To_Port_Kind (Get_Mode (Inter)); - Val := Get_Value (Syn_Inst, Inter); + Vt := Get_Value (Syn_Inst, Inter); Desc := (Name => Create_Inter_Name (Inter, Params.Encoding), Is_Inout => Pkind = Port_Inout, - W => Get_Type_Width (Val.Typ)); + W => Get_Type_Width (Vt.Typ)); case Pkind is when Port_In => @@ -545,7 +544,7 @@ package body Synth.Insts is case Get_Kind (Formal) is when Iir_Kind_Interface_Signal_Declaration => Off := 0; - Typ := Get_Value_Type (Inter_Inst, Get_Type (Formal)); + Typ := Get_Subtype_Object (Inter_Inst, Get_Type (Formal)); when Iir_Kind_Simple_Name => Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Named_Entity (Formal), Off, Typ); @@ -603,7 +602,7 @@ package body Synth.Insts is type Value_Offset_Record is record Off : Uns32; - Val : Value_Acc; + Val : Valtyp; end record; package Value_Offset_Tables is new Dyn_Tables @@ -638,7 +637,7 @@ package body Synth.Insts is is use Netlists.Concats; Iassoc : Node; - V : Value_Acc; + V : Valtyp; Off : Uns32; Typ : Type_Acc; Els : Value_Offset_Tables.Instance; @@ -695,7 +694,7 @@ package body Synth.Insts is Actual : Node; Formal_Typ : Type_Acc; Act_Inst : Synth_Instance_Acc; - Act : Value_Acc; + Act : Valtyp; begin case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is when Iir_Kind_Association_Element_Open => @@ -716,7 +715,7 @@ package body Synth.Insts is return Synth_Individual_Input_Assoc (Syn_Inst, Assoc, Inter_Inst); end case; - Formal_Typ := Get_Value_Type (Inter_Inst, Get_Type (Inter)); + Formal_Typ := Get_Subtype_Object (Inter_Inst, Get_Type (Inter)); Act := Synth_Expression_With_Type (Act_Inst, Actual, Formal_Typ); return Get_Net (Act); @@ -728,7 +727,7 @@ package body Synth.Insts is Inter_Inst : Synth_Instance_Acc) is Iassoc : Node; - V : Value_Acc; + V : Valtyp; Off : Uns32; Typ : Type_Acc; O : Net; @@ -765,7 +764,7 @@ package body Synth.Insts is Actual : Node; Formal_Typ : Type_Acc; Port : Net; - O : Value_Acc; + O : Valtyp; begin case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => @@ -834,7 +833,7 @@ package body Synth.Insts is if Inst_Obj.Encoding = Name_Parameters then declare Inter : Node; - Val : Value_Acc; + Vt : Valtyp; Vec : Logvec_Array_Acc; Len : Uns32; Off : Uns32; @@ -845,17 +844,17 @@ package body Synth.Insts is Idx := 0; Inter := Get_Generic_Chain (Inst_Obj.Decl); while Inter /= Null_Node loop - Val := Get_Value (Inst_Obj.Syn_Inst, Inter); - Len := (Val.Typ.W + 31) / 32; + Vt := Get_Value (Inst_Obj.Syn_Inst, Inter); + Len := (Vt.Typ.W + 31) / 32; pragma Assert (Len > 0); Vec := new Logvec_Array'(0 .. Digit_Index (Len - 1) => (0, 0)); Off := 0; Has_Zx := False; - Value2logvec (Val, Vec.all, Off, Has_Zx); + Value2logvec (Vt.Val, Vec.all, Off, Has_Zx); if Has_Zx then - Pv := Create_Pval4 (Val.Typ.W); + Pv := Create_Pval4 (Vt.Typ.W); else - Pv := Create_Pval2 (Val.Typ.W); + Pv := Create_Pval2 (Vt.Typ.W); end if; for I in 0 .. Len - 1 loop Write_Pval (Pv, I, Vec (Digit_Index (I))); @@ -890,7 +889,7 @@ package body Synth.Insts is end case; else Synth_Declaration_Type (Sub_Inst, Inter); - return Get_Value_Type (Sub_Inst, Get_Type (Inter)); + return Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); end if; end Synth_Port_Association_Type; @@ -919,7 +918,7 @@ package body Synth.Insts is | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); end case; - Create_Object (Sub_Inst, Inter, Val); + Create_Object (Sub_Inst, Inter, (Inter_Typ, Val)); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; @@ -1082,7 +1081,7 @@ package body Synth.Insts is Assoc : Node; Assoc_Inter : Node; Inter : Node; - Inter_Type : Type_Acc; + Inter_Typ : Type_Acc; Val : Value_Acc; N : Net; begin @@ -1092,21 +1091,21 @@ package body Synth.Insts is if Get_Whole_Association_Flag (Assoc) then Inter := Get_Association_Interface (Assoc, Assoc_Inter); - Inter_Type := Synth_Port_Association_Type + Inter_Typ := Synth_Port_Association_Type (Comp_Inst, Syn_Inst, Inter, Assoc); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => N := Synth_Input_Assoc (Syn_Inst, Assoc, Comp_Inst, Inter); - Val := Create_Value_Net (N, Inter_Type); + Val := Create_Value_Net (N, Inter_Typ); when Port_Out | Port_Inout => - Val := Create_Value_Wire (No_Wire_Id, Inter_Type); + Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); Create_Component_Wire (Get_Build (Syn_Inst), Assoc_Inter, Val, Inst_Name); end case; - Create_Object (Comp_Inst, Assoc_Inter, Val); + Create_Object (Comp_Inst, Assoc_Inter, (Val.Typ, Val)); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; @@ -1170,7 +1169,7 @@ package body Synth.Insts is Assoc_Inter : Node; Inter : Node; Port : Net; - O : Value_Acc; + O : Valtyp; Nbr_Outputs : Port_Nbr; begin Assoc := Get_Port_Map_Aspect_Chain (Stmt); @@ -1182,7 +1181,7 @@ package body Synth.Insts is if Mode_To_Port_Kind (Get_Mode (Inter)) = Port_Out then O := Get_Value (Comp_Inst, Inter); - Port := Get_Net (O); + Port := Get_Net (O.Val); Synth_Output_Assoc (Port, Syn_Inst, Assoc, Comp_Inst, Inter); Nbr_Outputs := Nbr_Outputs + 1; end if; @@ -1280,13 +1279,13 @@ package body Synth.Insts is while Is_Valid (Inter) loop Synth_Declaration_Type (Syn_Inst, Inter); declare - Val : Value_Acc; - Inter_Type : Type_Acc; + Val : Valtyp; + Inter_Typ : Type_Acc; begin - Inter_Type := Get_Value_Type (Syn_Inst, Get_Type (Inter)); + Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); Val := Synth_Expression_With_Type - (Syn_Inst, Get_Default_Value (Inter), Inter_Type); - pragma Assert (Is_Static (Val)); + (Syn_Inst, Get_Default_Value (Inter), Inter_Typ); + pragma Assert (Is_Static (Val.Val)); Create_Object (Syn_Inst, Inter, Val); end; Inter := Get_Chain (Inter); @@ -1302,7 +1301,7 @@ package body Synth.Insts is raise Internal_Error; end if; Synth_Declaration_Type (Syn_Inst, Inter); - Inter_Typ := Get_Value_Type (Syn_Inst, Get_Type (Inter)); + Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => Val := Create_Value_Net (No_Net, Inter_Typ); @@ -1310,7 +1309,7 @@ package body Synth.Insts is | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); end case; - Create_Object (Syn_Inst, Inter, Val); + Create_Object (Syn_Inst, Inter, (Inter_Typ, Val)); Inter := Get_Chain (Inter); end loop; @@ -1347,7 +1346,7 @@ package body Synth.Insts is Get_Output_Desc (Get_Module (Self_Inst), Idx); Inter_Typ : Type_Acc; Value : Net; - Init : Value_Acc; + Init : Valtyp; Inp : Input; begin pragma Assert (Val.Kind = Value_Wire); @@ -1374,7 +1373,7 @@ package body Synth.Insts is end; else if Default /= Null_Node then - Inter_Typ := Get_Value_Type (Syn_Inst, Get_Type (Inter)); + Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); Init := Synth_Expression_With_Type (Syn_Inst, Default, Inter_Typ); Init := Synth_Subtype_Conversion @@ -1464,7 +1463,7 @@ package body Synth.Insts is Syn_Inst : constant Synth_Instance_Acc := Inst.Syn_Inst; Self_Inst : Instance; Inter : Node; - Val : Value_Acc; + Vt : Valtyp; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; begin @@ -1484,15 +1483,15 @@ package body Synth.Insts is Nbr_Inputs := 0; Nbr_Outputs := 0; while Is_Valid (Inter) loop - Val := Get_Value (Syn_Inst, Inter); + Vt := Get_Value (Syn_Inst, Inter); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => - Create_Input_Wire (Self_Inst, Nbr_Inputs, Val); + Create_Input_Wire (Self_Inst, Nbr_Inputs, Vt.Val); Nbr_Inputs := Nbr_Inputs + 1; when Port_Out | Port_Inout => Create_Output_Wire - (Syn_Inst, Self_Inst, Inter, Nbr_Outputs, Val); + (Syn_Inst, Self_Inst, Inter, Nbr_Outputs, Vt.Val); Nbr_Outputs := Nbr_Outputs + 1; end case; Inter := Get_Chain (Inter); diff --git a/src/synth/synth-oper.adb b/src/synth/synth-oper.adb index cddb5ed49..9be4b6dc6 100644 --- a/src/synth/synth-oper.adb +++ b/src/synth/synth-oper.adb @@ -49,16 +49,17 @@ package body Synth.Oper is return Build2_Uresize (Build_Context, N, W, Get_Location (Loc)); end Synth_Uresize; - function Synth_Uresize (Val : Value_Acc; W : Width; Loc : Node) return Net + function Synth_Uresize (Val : Valtyp; W : Width; Loc : Node) return Net is Res : Net; begin - if Is_Static (Val) and then Val.Typ.Kind = Type_Discrete then - if Val.Typ.Drange.Is_Signed and then Val.Scal < 0 then + if Is_Static (Val.Val) and then Val.Typ.Kind = Type_Discrete then + if Val.Typ.Drange.Is_Signed and then Val.Val.Scal < 0 then -- TODO. raise Internal_Error; else - Res := Build2_Const_Uns (Build_Context, To_Uns64 (Val.Scal), W); + Res := Build2_Const_Uns + (Build_Context, To_Uns64 (Val.Val.Scal), W); end if; Set_Location (Res, Loc); return Res; @@ -66,13 +67,13 @@ package body Synth.Oper is return Synth_Uresize (Get_Net (Val), W, Loc); end Synth_Uresize; - function Synth_Sresize (Val : Value_Acc; W : Width; Loc : Node) return Net + function Synth_Sresize (Val : Valtyp; W : Width; Loc : Node) return Net is Res : Net; begin - if Is_Static (Val) and then Val.Typ.Kind = Type_Discrete then + if Is_Static (Val.Val) and then Val.Typ.Kind = Type_Discrete then if Val.Typ.Drange.Is_Signed then - Res := Build2_Const_Int (Build_Context, Val.Scal, W); + Res := Build2_Const_Int (Build_Context, Val.Val.Scal, W); else -- TODO. raise Internal_Error; @@ -84,19 +85,19 @@ package body Synth.Oper is Get_Location (Loc)); end Synth_Sresize; - function Synth_Bit_Eq_Const (Cst : Value_Acc; Expr : Value_Acc; Loc : Node) - return Value_Acc + function Synth_Bit_Eq_Const (Cst : Valtyp; Expr : Valtyp; Loc : Node) + return Valtyp is Val : Uns32; Zx : Uns32; N : Net; begin - if Is_Static (Expr) then - return Create_Value_Discrete (Boolean'Pos (Cst.Scal = Expr.Scal), - Boolean_Type); + if Is_Static (Expr.Val) then + return Create_Value_Discrete + (Boolean'Pos (Cst.Val.Scal = Expr.Val.Scal), Boolean_Type); end if; - To_Logic (Cst.Scal, Cst.Typ, Val, Zx); + To_Logic (Cst.Val.Scal, Cst.Typ, Val, Zx); if Zx /= 0 then -- Equal unknown -> return X N := Build_Const_UL32 (Build_Context, 0, 1, 1); @@ -120,7 +121,7 @@ package body Synth.Oper is -- Create the result range of an operator. According to the ieee standard, -- the range is LEN-1 downto 0. - function Create_Res_Bound (Prev : Value_Acc) return Type_Acc + function Create_Res_Bound (Prev : Valtyp) return Type_Acc is Res : Type_Acc; begin @@ -172,8 +173,8 @@ package body Synth.Oper is -- Do a match comparison between CST and OPER. -- Return No_Net if CST has incorrect value. - function Synth_Match (Cst : Value_Acc; - Oper : Value_Acc; + function Synth_Match (Cst : Valtyp; + Oper : Valtyp; Expr : Node; Op : Compare_Module_Id := Id_Eq) return Net is @@ -196,8 +197,8 @@ package body Synth.Oper is Boff := 0; Woff := 0; - for I in reverse Cst.Arr.V'Range loop - case Cst.Arr.V (I).Scal is + for I in reverse Cst.Val.Arr.V'Range loop + case Cst.Val.Arr.V (I).Scal is when Std_Logic_0_Pos | Std_Logic_L_Pos => B := 0; @@ -247,8 +248,7 @@ package body Synth.Oper is -- Note: LEFT or RIGHT can be a single bit. function Synth_Dyadic_Uns_Uns - (Id : Dyadic_Module_Id; Left, Right : Value_Acc; Expr : Node) - return Value_Acc + (Id : Dyadic_Module_Id; Left, Right : Valtyp; Expr : Node) return Valtyp is W : constant Width := Width'Max (Left.Typ.W, Right.Typ.W); El_Typ : Type_Acc; @@ -272,8 +272,7 @@ package body Synth.Oper is end Synth_Dyadic_Uns_Uns; function Synth_Dyadic_Uns_Nat - (Id : Dyadic_Module_Id; Left, Right : Value_Acc; Expr : Node) - return Value_Acc + (Id : Dyadic_Module_Id; Left, Right : Valtyp; Expr : Node) return Valtyp is L : constant Net := Get_Net (Left); R1 : Net; @@ -286,8 +285,7 @@ package body Synth.Oper is end Synth_Dyadic_Uns_Nat; function Synth_Dyadic_Nat_Uns - (Id : Dyadic_Module_Id; Left, Right : Value_Acc; Expr : Node) - return Value_Acc + (Id : Dyadic_Module_Id; Left, Right : Valtyp; Expr : Node) return Valtyp is R : constant Net := Get_Net (Right); L1 : Net; @@ -301,8 +299,7 @@ package body Synth.Oper is -- Note: LEFT or RIGHT can be a single bit. function Synth_Dyadic_Sgn_Sgn - (Id : Dyadic_Module_Id; Left, Right : Value_Acc; Expr : Node) - return Value_Acc + (Id : Dyadic_Module_Id; Left, Right : Valtyp; Expr : Node) return Valtyp is W : constant Width := Width'Max (Left.Typ.W, Right.Typ.W); El_Typ : Type_Acc; @@ -326,8 +323,7 @@ package body Synth.Oper is end Synth_Dyadic_Sgn_Sgn; function Synth_Dyadic_Sgn_Int - (Id : Dyadic_Module_Id; Left, Right : Value_Acc; Expr : Node) - return Value_Acc + (Id : Dyadic_Module_Id; Left, Right : Valtyp; Expr : Node) return Valtyp is L : constant Net := Get_Net (Left); R1 : Net; @@ -340,8 +336,7 @@ package body Synth.Oper is end Synth_Dyadic_Sgn_Int; function Synth_Dyadic_Int_Sgn - (Id : Dyadic_Module_Id; Left, Right : Value_Acc; Expr : Node) - return Value_Acc + (Id : Dyadic_Module_Id; Left, Right : Valtyp; Expr : Node) return Valtyp is R : constant Net := Get_Net (Right); L1 : Net; @@ -357,7 +352,7 @@ package body Synth.Oper is Imp : Node; Left_Expr : Node; Right_Expr : Node; - Expr : Node) return Value_Acc + Expr : Node) return Valtyp is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); Def : constant Iir_Predefined_Functions := @@ -367,13 +362,15 @@ package body Synth.Oper is Expr_Type : constant Node := Get_Type (Expr); Left_Type : constant Node := Get_Type (Inter_Chain); Right_Type : constant Node := Get_Type (Get_Chain (Inter_Chain)); - Left_Typ : constant Type_Acc := Get_Value_Type (Syn_Inst, Left_Type); - Right_Typ : constant Type_Acc := Get_Value_Type (Syn_Inst, Right_Type); - Expr_Typ : constant Type_Acc := Get_Value_Type (Syn_Inst, Expr_Type); - Left : Value_Acc; - Right : Value_Acc; - - function Synth_Bit_Dyadic (Id : Dyadic_Module_Id) return Value_Acc + Left_Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Left_Type); + Right_Typ : constant Type_Acc := + Get_Subtype_Object (Syn_Inst, Right_Type); + Expr_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Expr_Type); + Left : Valtyp; + Right : Valtyp; + + function Synth_Bit_Dyadic (Id : Dyadic_Module_Id) return Valtyp is N : Net; begin @@ -384,7 +381,7 @@ package body Synth.Oper is end Synth_Bit_Dyadic; function Synth_Compare (Id : Compare_Module_Id; Res_Type : Type_Acc) - return Value_Acc + return Valtyp is N : Net; begin @@ -396,7 +393,7 @@ package body Synth.Oper is return Create_Value_Net (N, Res_Type); end Synth_Compare; - function Synth_Minmax (Id : Compare_Module_Id) return Value_Acc + function Synth_Minmax (Id : Compare_Module_Id) return Valtyp is L : constant Net := Get_Net (Left); R : constant Net := Get_Net (Right); @@ -411,7 +408,7 @@ package body Synth.Oper is end Synth_Minmax; function Synth_Compare_Array (Id, Id_Eq : Compare_Module_Id; - Res_Type : Type_Acc) return Value_Acc + Res_Type : Type_Acc) return Valtyp is pragma Unreferenced (Id_Eq); N : Net; @@ -437,7 +434,7 @@ package body Synth.Oper is end Synth_Compare_Array; function Synth_Compare_Uns_Nat - (Id : Compare_Module_Id; Res_Type : Type_Acc) return Value_Acc + (Id : Compare_Module_Id; Res_Type : Type_Acc) return Valtyp is N : Net; begin @@ -448,7 +445,7 @@ package body Synth.Oper is end Synth_Compare_Uns_Nat; function Synth_Compare_Nat_Uns - (Id : Compare_Module_Id; Res_Type : Type_Acc) return Value_Acc + (Id : Compare_Module_Id; Res_Type : Type_Acc) return Valtyp is N : Net; begin @@ -459,7 +456,7 @@ package body Synth.Oper is end Synth_Compare_Nat_Uns; function Synth_Compare_Sgn_Int - (Id : Compare_Module_Id; Res_Typ : Type_Acc) return Value_Acc + (Id : Compare_Module_Id; Res_Typ : Type_Acc) return Valtyp is N : Net; begin @@ -470,7 +467,7 @@ package body Synth.Oper is end Synth_Compare_Sgn_Int; function Synth_Compare_Int_Sgn - (Id : Compare_Module_Id; Res_Typ : Type_Acc) return Value_Acc + (Id : Compare_Module_Id; Res_Typ : Type_Acc) return Valtyp is N : Net; begin @@ -480,7 +477,7 @@ package body Synth.Oper is return Create_Value_Net (N, Res_Typ); end Synth_Compare_Int_Sgn; - function Synth_Vec_Dyadic (Id : Dyadic_Module_Id) return Value_Acc + function Synth_Vec_Dyadic (Id : Dyadic_Module_Id) return Valtyp is N : Net; begin @@ -491,9 +488,9 @@ package body Synth.Oper is return Create_Value_Net (N, Create_Res_Bound (Left)); end Synth_Vec_Dyadic; - function Synth_Int_Dyadic (Id : Dyadic_Module_Id) return Value_Acc + function Synth_Int_Dyadic (Id : Dyadic_Module_Id) return Valtyp is - Etype : constant Type_Acc := Get_Value_Type (Syn_Inst, Expr_Type); + Etype : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Expr_Type); N : Net; begin N := Build_Dyadic @@ -503,7 +500,7 @@ package body Synth.Oper is end Synth_Int_Dyadic; function Synth_Compare_Uns_Uns - (Id : Compare_Module_Id; Res_Type : Type_Acc) return Value_Acc + (Id : Compare_Module_Id; Res_Type : Type_Acc) return Valtyp is W : constant Width := Width'Max (Left.Typ.W, Right.Typ.W); L1, R1 : Net; @@ -517,7 +514,7 @@ package body Synth.Oper is end Synth_Compare_Uns_Uns; function Synth_Compare_Sgn_Sgn - (Id : Compare_Module_Id; Res_Typ : Type_Acc) return Value_Acc + (Id : Compare_Module_Id; Res_Typ : Type_Acc) return Valtyp is W : constant Width := Width'Max (Left.Typ.W, Right.Typ.W); L1, R1 : Net; @@ -533,7 +530,7 @@ package body Synth.Oper is type Oper_Kind is (Oper_Left, Oper_Right); function Synth_Udivmod (Id : Dyadic_Module_Id; Vec : Oper_Kind) - return Value_Acc + return Valtyp is W : constant Width := Width'Max (Left.Typ.W, Right.Typ.W); L1, R1 : Net; @@ -556,7 +553,7 @@ package body Synth.Oper is end Synth_Udivmod; function Synth_Sdivmod (Id : Dyadic_Module_Id; Vec : Oper_Kind) - return Value_Acc + return Valtyp is W : constant Width := Width'Max (Left.Typ.W, Right.Typ.W); L1, R1 : Net; @@ -579,14 +576,14 @@ package body Synth.Oper is end Synth_Sdivmod; function Synth_Shift (Id_Pos : Module_Id; Id_Neg : Module_Id) - return Value_Acc + return Valtyp is pragma Unreferenced (Id_Neg); L1, R1 : Net; N : Net; Is_Pos : Boolean; begin - Is_Pos := Is_Positive (Right); + Is_Pos := Is_Positive (Right.Val); L1 := Get_Net (Left); R1 := Get_Net (Right); @@ -599,22 +596,22 @@ package body Synth.Oper is return Create_Value_Net (N, Create_Res_Bound (Left)); end Synth_Shift; - function Synth_Rotation (Id : Module_Id) return Value_Acc + function Synth_Rotation (Id : Module_Id) return Valtyp is Amt : Int64; Ww : Width; L1, R1 : Net; N : Net; begin - if Is_Static_Val (Right) then - Amt := Get_Static_Discrete (Right); + if Is_Static_Val (Right.Val) then + Amt := Get_Static_Discrete (Right.Val); if Amt < 0 then raise Internal_Error; end if; Amt := Amt mod Int64 (Left.Typ.W); R1 := Build_Const_UB32 (Ctxt, Uns32 (Amt), Right.Typ.W); Set_Location (R1, Right_Expr); - elsif not Is_Positive (Right) then + elsif not Is_Positive (Right.Val) then Error_Msg_Synth (+Expr, "rotation quantity must be unsigned"); return Left; else @@ -637,26 +634,26 @@ package body Synth.Oper is end Synth_Rotation; begin Left := Synth_Expression_With_Type (Syn_Inst, Left_Expr, Left_Typ); - if Left = null then - return null; + if Left = No_Valtyp then + return No_Valtyp; end if; Left := Synth_Subtype_Conversion (Left, Left_Typ, False, Expr); Strip_Const (Left); Right := Synth_Expression_With_Type (Syn_Inst, Right_Expr, Right_Typ); - if Right = null then - return null; + if Right = No_Valtyp then + return No_Valtyp; end if; Right := Synth_Subtype_Conversion (Right, Right_Typ, False, Expr); Strip_Const (Right); - if Is_Static_Val (Left) and Is_Static_Val (Right) then + if Is_Static_Val (Left.Val) and Is_Static_Val (Right.Val) then return Synth_Static_Dyadic_Predefined (Syn_Inst, Imp, Left, Right, Expr); end if; case Def is when Iir_Predefined_Error => - return null; + return No_Valtyp; when Iir_Predefined_Bit_And | Iir_Predefined_Boolean_And @@ -712,9 +709,9 @@ package body Synth.Oper is if Left_Typ = Bit_Type or else Left_Typ = Logic_Type then - if Is_Static (Left) then + if Is_Static (Left.Val) then return Synth_Bit_Eq_Const (Left, Right, Expr); - elsif Is_Static (Right) then + elsif Is_Static (Right.Val) then return Synth_Bit_Eq_Const (Right, Left, Expr); end if; end if; @@ -749,7 +746,7 @@ package body Synth.Oper is return Synth_Compare (Id_Eq, Boolean_Type); when Iir_Predefined_Std_Ulogic_Array_Match_Equality => declare - Cst, Oper : Value_Acc; + Cst, Oper : Valtyp; Res : Net; begin if Left.Typ.W /= Right.Typ.W then @@ -758,10 +755,10 @@ package body Synth.Oper is return Create_Value_Discrete (0, Bit_Type); end if; - if Is_Static (Left) then + if Is_Static (Left.Val) then Cst := Left; Oper := Right; - elsif Is_Static (Right) then + elsif Is_Static (Right.Val) then Cst := Right; Oper := Left; else @@ -778,7 +775,7 @@ package body Synth.Oper is end; when Iir_Predefined_Std_Ulogic_Array_Match_Inequality => declare - Cst, Oper : Value_Acc; + Cst, Oper : Valtyp; Res : Net; begin if Left.Typ.W /= Right.Typ.W then @@ -787,10 +784,10 @@ package body Synth.Oper is return Create_Value_Discrete (1, Bit_Type); end if; - if Is_Static (Left) then + if Is_Static (Left.Val) then Cst := Left; Oper := Right; - elsif Is_Static (Right) then + elsif Is_Static (Right.Val) then Cst := Right; Oper := Left; else @@ -1060,7 +1057,7 @@ package body Synth.Oper is when Iir_Predefined_Ieee_Numeric_Std_Lt_Uns_Nat | Iir_Predefined_Ieee_Numeric_Std_Match_Lt_Uns_Nat => -- "<" (Unsigned, Natural) - if Is_Static (Right) and then Right.Scal = 0 then + if Is_Static (Right.Val) and then Right.Val.Scal = 0 then -- Always false. return Create_Value_Discrete (0, Expr_Typ); end if; @@ -1238,13 +1235,13 @@ package body Synth.Oper is when Iir_Predefined_Integer_Div => return Synth_Int_Dyadic (Id_Sdiv); when Iir_Predefined_Integer_Mod => - if Is_Static_Val (Right) then + if Is_Static_Val (Right.Val) then -- Optimize when the divisor is a power of 2. declare use Mutils; Etype : constant Type_Acc := - Get_Value_Type (Syn_Inst, Expr_Type); - R : constant Int64 := Get_Static_Discrete (Right); + Get_Subtype_Object (Syn_Inst, Expr_Type); + R : constant Int64 := Get_Static_Discrete (Right.Val); Log_R : Natural; N : Net; begin @@ -1265,7 +1262,7 @@ package body Synth.Oper is when Iir_Predefined_Integer_Exp => Error_Msg_Synth (+Expr, "non-constant exponentiation not supported"); - return null; + return No_Valtyp; when Iir_Predefined_Integer_Less_Equal => return Synth_Compare (Id_Sle, Boolean_Type); when Iir_Predefined_Integer_Less => @@ -1284,11 +1281,11 @@ package body Synth.Oper is return Synth_Minmax (Id_Sgt); when Iir_Predefined_Physical_Physical_Div => Error_Msg_Synth (+Expr, "non-constant division not supported"); - return null; + return No_Valtyp; when Iir_Predefined_Floating_Div => Error_Msg_Synth (+Expr, "non-constant division not supported"); - return null; + return No_Valtyp; when Iir_Predefined_Ieee_Numeric_Std_Sra_Sgn_Int => return Synth_Shift (Id_Asr, Id_None); @@ -1302,24 +1299,24 @@ package body Synth.Oper is when others => Error_Msg_Synth (+Expr, "synth_dyadic_operation: unhandled " & Iir_Predefined_Functions'Image (Def)); - return null; + return No_Valtyp; end case; end Synth_Dyadic_Operation; function Synth_Monadic_Operation (Syn_Inst : Synth_Instance_Acc; Imp : Node; Operand_Expr : Node; - Loc : Node) return Value_Acc + Loc : Node) return Valtyp is Def : constant Iir_Predefined_Functions := Get_Implicit_Definition (Imp); Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); Oper_Type : constant Node := Get_Type (Inter_Chain); - Oper_Typ : constant Type_Acc := Get_Value_Type (Syn_Inst, Oper_Type); - Operand : Value_Acc; + Oper_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Oper_Type); + Operand : Valtyp; - function Synth_Bit_Monadic (Id : Monadic_Module_Id) return Value_Acc + function Synth_Bit_Monadic (Id : Monadic_Module_Id) return Valtyp is N : Net; begin @@ -1328,7 +1325,7 @@ package body Synth.Oper is return Create_Value_Net (N, Operand.Typ); end Synth_Bit_Monadic; - function Synth_Vec_Monadic (Id : Monadic_Module_Id) return Value_Acc + function Synth_Vec_Monadic (Id : Monadic_Module_Id) return Valtyp is Op: constant Net := Get_Net (Operand); N : Net; @@ -1338,8 +1335,7 @@ package body Synth.Oper is return Create_Value_Net (N, Create_Res_Bound (Operand)); end Synth_Vec_Monadic; - function Synth_Vec_Reduce_Monadic (Id : Reduce_Module_Id) - return Value_Acc + function Synth_Vec_Reduce_Monadic (Id : Reduce_Module_Id) return Valtyp is Op: constant Net := Get_Net (Operand); N : Net; @@ -1350,20 +1346,20 @@ package body Synth.Oper is end Synth_Vec_Reduce_Monadic; begin Operand := Synth_Expression_With_Type (Syn_Inst, Operand_Expr, Oper_Typ); - if Operand = null then - return null; + if Operand = No_Valtyp then + return No_Valtyp; end if; Operand := Synth_Subtype_Conversion (Operand, Oper_Typ, False, Loc); Strip_Const (Operand); - if Is_Static_Val (Operand) then + if Is_Static_Val (Operand.Val) then return Synth_Static_Monadic_Predefined (Syn_Inst, Imp, Operand, Loc); end if; case Def is when Iir_Predefined_Error => - return null; + return No_Valtyp; when Iir_Predefined_Ieee_1164_Scalar_Not => return Synth_Bit_Monadic (Id_Not); when Iir_Predefined_Boolean_Not @@ -1384,7 +1380,8 @@ package body Synth.Oper is return Synth_Vec_Reduce_Monadic(Id_Red_Or); when Iir_Predefined_Ieee_1164_Condition_Operator => return Create_Value_Net - (Get_Net (Operand), Get_Value_Type (Syn_Inst, Get_Type (Imp))); + (Get_Net (Operand), + Get_Subtype_Object (Syn_Inst, Get_Type (Imp))); when Iir_Predefined_Integer_Negation => declare N : Net; @@ -1402,8 +1399,8 @@ package body Synth.Oper is end Synth_Monadic_Operation; function Synth_Shift_Rotate (Id : Shift_Rotate_Module_Id; - Left, Right : Value_Acc; - Expr : Node) return Value_Acc + Left, Right : Valtyp; + Expr : Node) return Valtyp is L : constant Net := Get_Net (Left); N : Net; @@ -1414,7 +1411,7 @@ package body Synth.Oper is end Synth_Shift_Rotate; function Synth_Dynamic_Predefined_Function_Call - (Subprg_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc + (Subprg_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is Ctxt : constant Context_Acc := Get_Build (Subprg_Inst); Imp : constant Node := Get_Implementation (Expr); @@ -1424,31 +1421,30 @@ package body Synth.Oper is Param1 : Node; Param2 : Node; Res_Typ : constant Type_Acc := - Get_Value_Type (Subprg_Inst, Get_Type (Imp)); + Get_Subtype_Object (Subprg_Inst, Get_Type (Imp)); -- Resize PARAM1 to PARAM2 bit according to IS_SIGNED. - function Synth_Conv_Vector (Is_Signed : Boolean) return Value_Acc + function Synth_Conv_Vector (Is_Signed : Boolean) return Valtyp is - Arg : constant Value_Acc := Get_Value (Subprg_Inst, Param1); - Size_Val : Value_Acc; + Arg : constant Valtyp := Get_Value (Subprg_Inst, Param1); + Size_Vt : constant Valtyp := Get_Value (Subprg_Inst, Param2); Size : Width; Arg_Net : Net; begin - Size_Val := Get_Value (Subprg_Inst, Param2); - if not Is_Static (Size_Val) then + if not Is_Static (Size_Vt.Val) then Error_Msg_Synth (+Expr, "size parameter must be constant"); - return null; + return No_Valtyp; end if; - Size := Uns32 (Strip_Const (Size_Val).Scal); - Arg_Net := Get_Net (Arg); + Size := Uns32 (Strip_Const (Size_Vt.Val).Scal); + Arg_Net := Get_Net (Arg.Val); Arg_Net := Build2_Resize (Ctxt, Arg_Net, Size, Is_Signed, Get_Location (Expr)); return Create_Value_Net (Arg_Net, Create_Vec_Type_By_Length (Size, Logic_Type)); end Synth_Conv_Vector; - L : Value_Acc; - R : Value_Acc; + L : Valtyp; + R : Valtyp; begin Param1 := Inter_Chain; if Param1 /= Null_Node then @@ -1457,11 +1453,11 @@ package body Synth.Oper is if Param2 /= Null_Node then R := Get_Value (Subprg_Inst, Param2); else - R := null; + R := No_Valtyp; end if; else - L := null; - R := null; + L := No_Valtyp; + R := No_Valtyp; Param2 := Null_Node; end if; @@ -1494,7 +1490,7 @@ package body Synth.Oper is | Iir_Predefined_Ieee_1164_To_Stdlogicvector_Bv | Iir_Predefined_Ieee_Numeric_Std_To_01_Uns | Iir_Predefined_Ieee_Numeric_Std_To_01_Sgn => - if Is_Static (L) then + if Is_Static (L.Val) then raise Internal_Error; end if; return Create_Value_Net (Get_Net (L), Create_Res_Bound (L)); @@ -1518,11 +1514,11 @@ package body Synth.Oper is declare W : Width; begin - if not Is_Static (R) then + if not Is_Static (R.Val) then Error_Msg_Synth (+Expr, "size must be constant"); - return null; + return No_Valtyp; end if; - W := Uns32 (R.Scal); + W := Uns32 (R.Val.Scal); return Create_Value_Net (Synth_Uresize (Get_Net (L), W, Expr), Create_Vec_Type_By_Length (W, Logic_Type)); @@ -1531,11 +1527,11 @@ package body Synth.Oper is declare W : Width; begin - if not Is_Static (R) then + if not Is_Static (R.Val) then Error_Msg_Synth (+Expr, "size must be constant"); - return null; + return No_Valtyp; end if; - W := Uns32 (R.Scal); + W := Uns32 (R.Val.Scal); return Create_Value_Net (Build2_Sresize (Ctxt, Get_Net (L), W, Get_Location (Expr)), Create_Vec_Type_By_Length (W, Logic_Type)); @@ -1586,19 +1582,19 @@ package body Synth.Oper is when Iir_Predefined_Ieee_Numeric_Std_Match_Suv | Iir_Predefined_Ieee_Numeric_Std_Match_Slv => declare - Cst, Oper : Value_Acc; + Cst, Oper : Valtyp; Res : Net; begin - if Is_Static (L) then + if Is_Static (L.Val) then Cst := L; Oper := R; - elsif Is_Static (R) then + elsif Is_Static (R.Val) then Cst := R; Oper := L; else Error_Msg_Synth (+Expr, "one operand of std_match must be constant"); - return null; + return No_Valtyp; end if; if Oper.Typ.W /= Cst.Typ.W then Error_Msg_Synth @@ -1616,12 +1612,12 @@ package body Synth.Oper is Error_Msg_Synth (+Expr, "unhandled function: " & Iir_Predefined_Functions'Image (Def)); - return null; + return No_Valtyp; end case; end Synth_Dynamic_Predefined_Function_Call; function Synth_Predefined_Function_Call - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is Imp : constant Node := Get_Implementation (Expr); Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Expr); @@ -1630,7 +1626,7 @@ package body Synth.Oper is Subprg_Inst : Synth_Instance_Acc; M : Areapools.Mark_Type; Static : Boolean; - Res : Value_Acc; + Res : Valtyp; begin Areapools.Mark (M, Instance_Pool.all); Subprg_Inst := Make_Instance (Syn_Inst, Imp); @@ -1642,7 +1638,7 @@ package body Synth.Oper is Static := True; Inter := Inter_Chain; while Inter /= Null_Node loop - if not Is_Static (Get_Value (Subprg_Inst, Inter)) then + if not Is_Static (Get_Value (Subprg_Inst, Inter).Val) then Static := False; exit; end if; @@ -1662,7 +1658,7 @@ package body Synth.Oper is end Synth_Predefined_Function_Call; function Synth_Operator_Function_Call - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is Imp : constant Node := Get_Implementation (Expr); Assoc : Node; diff --git a/src/synth/synth-oper.ads b/src/synth/synth-oper.ads index 1bf30562b..eba256c93 100644 --- a/src/synth/synth-oper.ads +++ b/src/synth/synth-oper.ads @@ -24,20 +24,20 @@ with Vhdl.Nodes; use Vhdl.Nodes; package Synth.Oper is function Synth_Predefined_Function_Call - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; function Synth_Operator_Function_Call - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; function Synth_Dyadic_Operation (Syn_Inst : Synth_Instance_Acc; Imp : Node; Left_Expr : Node; Right_Expr : Node; - Expr : Node) return Value_Acc; + Expr : Node) return Valtyp; function Synth_Monadic_Operation (Syn_Inst : Synth_Instance_Acc; Imp : Node; Operand_Expr : Node; - Loc : Node) return Value_Acc; + Loc : Node) return Valtyp; function Create_Bounds_From_Length (Syn_Inst : Synth_Instance_Acc; Atype : Iir; Len : Iir_Index32) diff --git a/src/synth/synth-static_oper.adb b/src/synth/synth-static_oper.adb index d01261213..be54806b8 100644 --- a/src/synth/synth-static_oper.adb +++ b/src/synth/synth-static_oper.adb @@ -54,19 +54,19 @@ package body Synth.Static_Oper is end case; end record; - function Get_Static_Array (V : Value_Acc) return Static_Arr_Type + function Get_Static_Array (V : Valtyp) return Static_Arr_Type is N : Net; begin - case V.Kind is + case V.Val.Kind is when Value_Const => - return (Kind => Sarr_Value, Arr => V.C_Val.Arr); + return (Kind => Sarr_Value, Arr => V.Val.C_Val.Arr); when Value_Const_Array => - return (Kind => Sarr_Value, Arr => V.Arr); + return (Kind => Sarr_Value, Arr => V.Val.Arr); when Value_Net => - N := V.N; + N := V.Val.N; when Value_Wire => - N := Synth.Environment.Get_Const_Wire (V.W); + N := Synth.Environment.Get_Const_Wire (V.Val.W); when others => raise Internal_Error; end case; @@ -117,7 +117,7 @@ package body Synth.Static_Oper is end Warn_Compare_Meta; function Synth_Compare_Uns_Uns - (Left, Right : Value_Acc; Err : Compare_Type; Loc : Node) + (Left, Right : Valtyp; Err : Compare_Type; Loc : Node) return Compare_Type is Lw : constant Uns32 := Left.Typ.W; @@ -174,7 +174,7 @@ package body Synth.Static_Oper is end Synth_Compare_Uns_Uns; function Synth_Compare_Uns_Nat - (Left, Right : Value_Acc; Err : Compare_Type; Loc : Node) + (Left, Right : Valtyp; Err : Compare_Type; Loc : Node) return Compare_Type is Lw : constant Uns32 := Left.Typ.W; @@ -230,7 +230,7 @@ package body Synth.Static_Oper is end Synth_Compare_Uns_Nat; function Synth_Compare_Nat_Uns - (Left, Right : Value_Acc; Err : Compare_Type; Loc : Node) + (Left, Right : Valtyp; Err : Compare_Type; Loc : Node) return Compare_Type is Rw : constant Uns32 := Right.Typ.W; @@ -297,9 +297,9 @@ package body Synth.Static_Oper is return Create_Vec_Type_By_Length (Prev.W, Prev.Vec_El); end Create_Res_Bound; - function Synth_Vector_Dyadic (Left, Right : Value_Acc; + function Synth_Vector_Dyadic (Left, Right : Valtyp; Op : Table_2d; - Loc : Syn_Src) return Value_Acc + Loc : Syn_Src) return Valtyp is El_Typ : constant Type_Acc := Left.Typ.Vec_El; Larr : constant Static_Arr_Type := Get_Static_Array (Left); @@ -308,7 +308,7 @@ package body Synth.Static_Oper is begin if Left.Typ.W /= Right.Typ.W then Error_Msg_Synth (+Loc, "length of operands mismatch"); - return null; + return No_Valtyp; end if; Arr := Create_Value_Array (Iir_Index32 (Left.Typ.W)); @@ -328,14 +328,14 @@ package body Synth.Static_Oper is end Synth_Vector_Dyadic; procedure To_Std_Logic_Vector - (Val : Value_Acc; Arr : out Std_Logic_Vector) + (Val : Valtyp; Arr : out Std_Logic_Vector) is Sarr : constant Static_Arr_Type := Get_Static_Array (Val); begin case Sarr.Kind is when Sarr_Value => - for I in Val.Arr.V'Range loop - Arr (Natural (I)) := Std_Ulogic'Val (Val.Arr.V (I).Scal); + for I in Val.Val.Arr.V'Range loop + Arr (Natural (I)) := Std_Ulogic'Val (Val.Val.Arr.V (I).Scal); end loop; when Sarr_Net => for I in Arr'Range loop @@ -344,8 +344,8 @@ package body Synth.Static_Oper is end case; end To_Std_Logic_Vector; - function To_Value_Acc (Vec : Std_Logic_Vector; El_Typ : Type_Acc) - return Value_Acc + function To_Valtyp (Vec : Std_Logic_Vector; El_Typ : Type_Acc) + return Valtyp is pragma Assert (Vec'First = 1); Res_Typ : Type_Acc; @@ -358,138 +358,130 @@ package body Synth.Static_Oper is Create_Value_Discrete (Std_Ulogic'Pos (Vec (I)), El_Typ); end loop; return Create_Value_Const_Array (Res_Typ, Arr); - end To_Value_Acc; + end To_Valtyp; - function Synth_Add_Uns_Uns (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Add_Uns_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); + R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); declare Res_Arr : constant Std_Logic_Vector := Add_Uns_Uns (L_Arr, R_Arr); begin - return To_Value_Acc (Res_Arr, L.Typ.Vec_El); + return To_Valtyp (Res_Arr, L.Typ.Vec_El); end; end Synth_Add_Uns_Uns; - function Synth_Add_Sgn_Int (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Add_Sgn_Int (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Arr.Len)); - R_Val : constant Int64 := R.Scal; + L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); + R_Val : constant Int64 := R.Val.Scal; begin To_Std_Logic_Vector (L, L_Arr); declare Res_Arr : constant Std_Logic_Vector := Add_Sgn_Int (L_Arr, R_Val); begin - return To_Value_Acc (Res_Arr, L.Typ.Vec_El); + return To_Valtyp (Res_Arr, L.Typ.Vec_El); end; end Synth_Add_Sgn_Int; - function Synth_Add_Uns_Nat (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Add_Uns_Nat (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); L_Arr : Std_Logic_Vector (1 .. Natural (L.Typ.W)); - R_Val : constant Uns64 := Uns64 (R.Scal); + R_Val : constant Uns64 := Uns64 (R.Val.Scal); begin To_Std_Logic_Vector (L, L_Arr); declare Res_Arr : constant Std_Logic_Vector := Add_Uns_Nat (L_Arr, R_Val); begin - return To_Value_Acc (Res_Arr, L.Typ.Vec_El); + return To_Valtyp (Res_Arr, L.Typ.Vec_El); end; end Synth_Add_Uns_Nat; - function Synth_Sub_Uns_Uns (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Sub_Uns_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); + R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); declare Res_Arr : constant Std_Logic_Vector := Sub_Uns_Uns (L_Arr, R_Arr); begin - return To_Value_Acc (Res_Arr, L.Typ.Vec_El); + return To_Valtyp (Res_Arr, L.Typ.Vec_El); end; end Synth_Sub_Uns_Uns; - function Synth_Sub_Uns_Nat (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Sub_Uns_Nat (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Arr.Len)); - R_Val : constant Uns64 := Uns64 (R.Scal); + L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); + R_Val : constant Uns64 := Uns64 (R.Val.Scal); begin To_Std_Logic_Vector (L, L_Arr); declare Res_Arr : constant Std_Logic_Vector := Sub_Uns_Nat (L_Arr, R_Val); begin - return To_Value_Acc (Res_Arr, L.Typ.Vec_El); + return To_Valtyp (Res_Arr, L.Typ.Vec_El); end; end Synth_Sub_Uns_Nat; - function Synth_Mul_Uns_Uns (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Mul_Uns_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); + R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); declare Res_Arr : constant Std_Logic_Vector := Mul_Uns_Uns (L_Arr, R_Arr); begin - return To_Value_Acc (Res_Arr, L.Typ.Vec_El); + return To_Valtyp (Res_Arr, L.Typ.Vec_El); end; end Synth_Mul_Uns_Uns; - function Synth_Mul_Nat_Uns (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Mul_Nat_Uns (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Arr.Len)); - L_Val : constant Uns64 := Uns64 (L.Scal); + R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); + L_Val : constant Uns64 := Uns64 (L.Val.Scal); begin To_Std_Logic_Vector (R, R_Arr); declare Res_Arr : constant Std_Logic_Vector := Mul_Nat_Uns (L_Val, R_Arr); begin - return To_Value_Acc (Res_Arr, R.Typ.Vec_El); + return To_Valtyp (Res_Arr, R.Typ.Vec_El); end; end Synth_Mul_Nat_Uns; - function Synth_Mul_Sgn_Sgn (L, R : Value_Acc; Loc : Syn_Src) - return Value_Acc + function Synth_Mul_Sgn_Sgn (L, R : Valtyp; Loc : Syn_Src) return Valtyp is pragma Unreferenced (Loc); - L_Arr : Std_Logic_Vector (1 .. Natural (L.Arr.Len)); - R_Arr : Std_Logic_Vector (1 .. Natural (R.Arr.Len)); + L_Arr : Std_Logic_Vector (1 .. Natural (L.Val.Arr.Len)); + R_Arr : Std_Logic_Vector (1 .. Natural (R.Val.Arr.Len)); begin To_Std_Logic_Vector (L, L_Arr); To_Std_Logic_Vector (R, R_Arr); declare Res_Arr : constant Std_Logic_Vector := Mul_Sgn_Sgn (L_Arr, R_Arr); begin - return To_Value_Acc (Res_Arr, L.Typ.Vec_El); + return To_Valtyp (Res_Arr, L.Typ.Vec_El); end; end Synth_Mul_Sgn_Sgn; - function Synth_Shift (Val : Value_Acc; + function Synth_Shift (Val : Valtyp; Amt : Uns32; Right : Boolean; - Arith : Boolean) return Value_Acc + Arith : Boolean) return Valtyp is - Len : constant Uns32 := Uns32 (Val.Arr.Len); + Len : constant Uns32 := Uns32 (Val.Val.Arr.Len); Arr : Std_Logic_Vector (1 .. Natural (Len)); Pad : Std_Ulogic; begin @@ -519,28 +511,28 @@ package body Synth.Static_Oper is end loop; end if; end if; - return To_Value_Acc (Arr, Val.Typ.Vec_El); + return To_Valtyp (Arr, Val.Typ.Vec_El); end Synth_Shift; - function Get_Static_Ulogic (Op : Value_Acc) return Std_Ulogic is + function Get_Static_Ulogic (Op : Valtyp) return Std_Ulogic is begin return Std_Ulogic'Val (Get_Static_Discrete (Op)); end Get_Static_Ulogic; function Synth_Static_Dyadic_Predefined (Syn_Inst : Synth_Instance_Acc; Imp : Node; - Left : Value_Acc; - Right : Value_Acc; - Expr : Node) return Value_Acc + Left : Valtyp; + Right : Valtyp; + Expr : Node) return Valtyp is Def : constant Iir_Predefined_Functions := Get_Implicit_Definition (Imp); Res_Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Type (Expr)); + Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); begin case Def is when Iir_Predefined_Error => - return null; + return No_Valtyp; when Iir_Predefined_Boolean_Xor => return Create_Value_Discrete @@ -586,10 +578,10 @@ package body Synth.Static_Oper is Res_Typ); when Iir_Predefined_Integer_Rem => return Create_Value_Discrete - (Left.Scal rem Right.Scal, Res_Typ); + (Left.Val.Scal rem Right.Val.Scal, Res_Typ); when Iir_Predefined_Integer_Exp => return Create_Value_Discrete - (Left.Scal ** Natural (Right.Scal), Res_Typ); + (Left.Val.Scal ** Natural (Right.Val.Scal), Res_Typ); when Iir_Predefined_Physical_Minimum | Iir_Predefined_Integer_Minimum => return Create_Value_Discrete @@ -605,19 +597,19 @@ package body Synth.Static_Oper is when Iir_Predefined_Integer_Less_Equal | Iir_Predefined_Physical_Less_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Scal <= Right.Scal), Boolean_Type); + (Boolean'Pos (Left.Val.Scal <= Right.Val.Scal), Boolean_Type); when Iir_Predefined_Integer_Less | Iir_Predefined_Physical_Less => return Create_Value_Discrete - (Boolean'Pos (Left.Scal < Right.Scal), Boolean_Type); + (Boolean'Pos (Left.Val.Scal < Right.Val.Scal), Boolean_Type); when Iir_Predefined_Integer_Greater_Equal | Iir_Predefined_Physical_Greater_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Scal >= Right.Scal), Boolean_Type); + (Boolean'Pos (Left.Val.Scal >= Right.Val.Scal), Boolean_Type); when Iir_Predefined_Integer_Greater | Iir_Predefined_Physical_Greater => return Create_Value_Discrete - (Boolean'Pos (Left.Scal > Right.Scal), Boolean_Type); + (Boolean'Pos (Left.Val.Scal > Right.Val.Scal), Boolean_Type); when Iir_Predefined_Integer_Equality | Iir_Predefined_Physical_Equality => return Create_Value_Discrete @@ -632,55 +624,55 @@ package body Synth.Static_Oper is when Iir_Predefined_Physical_Real_Mul => return Create_Value_Discrete - (Int64 (Fp64 (Left.Scal) * Right.Fp), Res_Typ); + (Int64 (Fp64 (Left.Val.Scal) * Right.Val.Fp), Res_Typ); when Iir_Predefined_Real_Physical_Mul => return Create_Value_Discrete - (Int64 (Left.Fp * Fp64 (Right.Scal)), Res_Typ); + (Int64 (Left.Val.Fp * Fp64 (Right.Val.Scal)), Res_Typ); when Iir_Predefined_Physical_Real_Div => return Create_Value_Discrete - (Int64 (Fp64 (Left.Scal) / Right.Fp), Res_Typ); + (Int64 (Fp64 (Left.Val.Scal) / Right.Val.Fp), Res_Typ); when Iir_Predefined_Floating_Less => return Create_Value_Discrete - (Boolean'Pos (Left.Fp < Right.Fp), Boolean_Type); + (Boolean'Pos (Left.Val.Fp < Right.Val.Fp), Boolean_Type); when Iir_Predefined_Floating_Less_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Fp <= Right.Fp), Boolean_Type); + (Boolean'Pos (Left.Val.Fp <= Right.Val.Fp), Boolean_Type); when Iir_Predefined_Floating_Equality => return Create_Value_Discrete - (Boolean'Pos (Left.Fp = Right.Fp), Boolean_Type); + (Boolean'Pos (Left.Val.Fp = Right.Val.Fp), Boolean_Type); when Iir_Predefined_Floating_Inequality => return Create_Value_Discrete - (Boolean'Pos (Left.Fp /= Right.Fp), Boolean_Type); + (Boolean'Pos (Left.Val.Fp /= Right.Val.Fp), Boolean_Type); when Iir_Predefined_Floating_Greater => return Create_Value_Discrete - (Boolean'Pos (Left.Fp > Right.Fp), Boolean_Type); + (Boolean'Pos (Left.Val.Fp > Right.Val.Fp), Boolean_Type); when Iir_Predefined_Floating_Greater_Equal => return Create_Value_Discrete - (Boolean'Pos (Left.Fp >= Right.Fp), Boolean_Type); + (Boolean'Pos (Left.Val.Fp >= Right.Val.Fp), Boolean_Type); when Iir_Predefined_Floating_Plus => - return Create_Value_Float (Left.Fp + Right.Fp, Res_Typ); + return Create_Value_Float (Left.Val.Fp + Right.Val.Fp, Res_Typ); when Iir_Predefined_Floating_Minus => - return Create_Value_Float (Left.Fp - Right.Fp, Res_Typ); + return Create_Value_Float (Left.Val.Fp - Right.Val.Fp, Res_Typ); when Iir_Predefined_Floating_Mul => - return Create_Value_Float (Left.Fp * Right.Fp, Res_Typ); + return Create_Value_Float (Left.Val.Fp * Right.Val.Fp, Res_Typ); when Iir_Predefined_Floating_Div => - return Create_Value_Float (Left.Fp / Right.Fp, Res_Typ); + return Create_Value_Float (Left.Val.Fp / Right.Val.Fp, Res_Typ); when Iir_Predefined_Floating_Exp => return Create_Value_Float - (Left.Fp ** Natural (Right.Scal), Res_Typ); + (Left.Val.Fp ** Natural (Right.Val.Scal), Res_Typ); when Iir_Predefined_Array_Array_Concat => declare Ret_Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); + Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp)); L_Len : constant Iir_Index32 := Iir_Index32 (Get_Bound_Length (Left.Typ, 1)); R_Len : constant Iir_Index32 := Iir_Index32 (Get_Bound_Length (Right.Typ, 1)); - L : constant Value_Acc := Strip_Alias_Const (Left); - R : constant Value_Acc := Strip_Alias_Const (Right); + L : constant Valtyp := Strip_Alias_Const (Left); + R : constant Valtyp := Strip_Alias_Const (Right); Bnd : Bound_Type; Res_Typ : Type_Acc; Arr : Value_Array_Acc; @@ -692,69 +684,69 @@ package body Synth.Static_Oper is (Ret_Typ, Bnd); Arr := Create_Value_Array (L_Len + R_Len); for I in 1 .. L_Len loop - Arr.V (I) := L.Arr.V (I); + Arr.V (I) := L.Val.Arr.V (I); end loop; for I in 1 .. R_Len loop - Arr.V (L_Len + I) := R.Arr.V (I); + Arr.V (L_Len + I) := R.Val.Arr.V (I); end loop; return Create_Value_Const_Array (Res_Typ, Arr); end; when Iir_Predefined_Element_Array_Concat => declare Ret_Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); + Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp)); Bnd : Bound_Type; Res_Typ : Type_Acc; Arr : Value_Array_Acc; begin Bnd := Oper.Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - 1 + Right.Arr.Len); + 1 + Right.Val.Arr.Len); Res_Typ := Create_Onedimensional_Array_Subtype (Ret_Typ, Bnd); - Arr := Create_Value_Array (1 + Right.Arr.Len); - Arr.V (1) := Left; - for I in Right.Arr.V'Range loop - Arr.V (1 + I) := Right.Arr.V (I); + Arr := Create_Value_Array (1 + Right.Val.Arr.Len); + Arr.V (1) := Left.Val; + for I in Right.Val.Arr.V'Range loop + Arr.V (1 + I) := Right.Val.Arr.V (I); end loop; return Create_Value_Const_Array (Res_Typ, Arr); end; when Iir_Predefined_Array_Element_Concat => declare Ret_Typ : constant Type_Acc := - Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); + Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp)); Bnd : Bound_Type; Res_Typ : Type_Acc; Arr : Value_Array_Acc; begin Bnd := Oper.Create_Bounds_From_Length (Syn_Inst, Get_Index_Type (Get_Type (Expr), 0), - Left.Arr.Len + 1); + Left.Val.Arr.Len + 1); Res_Typ := Create_Onedimensional_Array_Subtype (Ret_Typ, Bnd); - Arr := Create_Value_Array (Left.Arr.Len + 1); - for I in Left.Arr.V'Range loop - Arr.V (I) := Left.Arr.V (I); + Arr := Create_Value_Array (Left.Val.Arr.Len + 1); + for I in Left.Val.Arr.V'Range loop + Arr.V (I) := Left.Val.Arr.V (I); end loop; - Arr.V (Left.Arr.Len + 1) := Right; + Arr.V (Left.Val.Arr.Len + 1) := Right.Val; return Create_Value_Const_Array (Res_Typ, Arr); end; when Iir_Predefined_Array_Equality | Iir_Predefined_Record_Equality => return Create_Value_Discrete - (Boolean'Pos (Is_Equal (Left, Right)), Boolean_Type); + (Boolean'Pos (Is_Equal (Left.Val, Right.Val)), Boolean_Type); when Iir_Predefined_Array_Inequality | Iir_Predefined_Record_Inequality => return Create_Value_Discrete - (Boolean'Pos (not Is_Equal (Left, Right)), Boolean_Type); + (Boolean'Pos (not Is_Equal (Left.Val, Right.Val)), Boolean_Type); when Iir_Predefined_Access_Equality => return Create_Value_Discrete - (Boolean'Pos (Left.Acc = Right.Acc), Boolean_Type); + (Boolean'Pos (Left.Val.Acc = Right.Val.Acc), Boolean_Type); when Iir_Predefined_Access_Inequality => return Create_Value_Discrete - (Boolean'Pos (Left.Acc /= Right.Acc), Boolean_Type); + (Boolean'Pos (Left.Val.Acc /= Right.Val.Acc), Boolean_Type); when Iir_Predefined_Ieee_1164_Vector_And | Iir_Predefined_Ieee_Numeric_Std_And_Uns_Uns @@ -911,20 +903,20 @@ package body Synth.Static_Oper is Error_Msg_Synth (+Expr, "synth_static_dyadic_predefined: unhandled " & Iir_Predefined_Functions'Image (Def)); - return null; + return No_Valtyp; end case; end Synth_Static_Dyadic_Predefined; function Synth_Vector_Monadic - (Vec : Value_Acc; Op : Table_1d) return Value_Acc + (Vec : Valtyp; Op : Table_1d) return Valtyp is El_Typ : constant Type_Acc := Vec.Typ.Vec_El; Arr : Value_Array_Acc; begin - Arr := Create_Value_Array (Vec.Arr.Len); + Arr := Create_Value_Array (Vec.Val.Arr.Len); for I in Arr.V'Range loop declare - V : constant Std_Ulogic := Std_Ulogic'Val (Vec.Arr.V (I).Scal); + V : constant Std_Ulogic := Std_Ulogic'Val (Vec.Val.Arr.V (I).Scal); begin Arr.V (I) := Create_Value_Discrete (Std_Ulogic'Pos (Op (V)), El_Typ); @@ -935,16 +927,16 @@ package body Synth.Static_Oper is end Synth_Vector_Monadic; function Synth_Vector_Reduce - (Init : Std_Ulogic; Vec : Value_Acc; Op : Table_2d) return Value_Acc + (Init : Std_Ulogic; Vec : Valtyp; Op : Table_2d) return Valtyp is El_Typ : constant Type_Acc := Vec.Typ.Vec_El; Res : Std_Ulogic; begin Res := Init; - for I in Vec.Arr.V'Range loop + for I in Vec.Val.Arr.V'Range loop declare V : constant Std_Ulogic := - Std_Ulogic'Val (Vec.Arr.V (I).Scal); + Std_Ulogic'Val (Vec.Val.Arr.V (I).Scal); begin Res := Op (Res, V); end; @@ -955,39 +947,39 @@ package body Synth.Static_Oper is function Synth_Static_Monadic_Predefined (Syn_Inst : Synth_Instance_Acc; Imp : Node; - Operand : Value_Acc; - Expr : Node) return Value_Acc + Operand : Valtyp; + Expr : Node) return Valtyp is Def : constant Iir_Predefined_Functions := Get_Implicit_Definition (Imp); Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); Oper_Type : constant Node := Get_Type (Inter_Chain); - Oper_Typ : constant Type_Acc := Get_Value_Type (Syn_Inst, Oper_Type); + Oper_Typ : constant Type_Acc := Get_Subtype_Object (Syn_Inst, Oper_Type); -- Res_Typ : constant Type_Acc := - -- Get_Value_Type (Syn_Inst, Get_Type (Expr)); + -- Get_Subtype_Object (Syn_Inst, Get_Type (Expr)); begin case Def is when Iir_Predefined_Boolean_Not | Iir_Predefined_Bit_Not => - return Create_Value_Discrete (1 - Operand.Scal, Oper_Typ); + return Create_Value_Discrete (1 - Operand.Val.Scal, Oper_Typ); when Iir_Predefined_Integer_Negation | Iir_Predefined_Physical_Negation => - return Create_Value_Discrete (-Operand.Scal, Oper_Typ); + return Create_Value_Discrete (-Operand.Val.Scal, Oper_Typ); when Iir_Predefined_Integer_Absolute | Iir_Predefined_Physical_Absolute => - return Create_Value_Discrete (abs Operand.Scal, Oper_Typ); + return Create_Value_Discrete (abs Operand.Val.Scal, Oper_Typ); when Iir_Predefined_Integer_Identity | Iir_Predefined_Physical_Identity => return Operand; when Iir_Predefined_Floating_Negation => - return Create_Value_Float (-Operand.Fp, Oper_Typ); + return Create_Value_Float (-Operand.Val.Fp, Oper_Typ); when Iir_Predefined_Floating_Identity => return Operand; when Iir_Predefined_Floating_Absolute => - return Create_Value_Float (abs Operand.Fp, Oper_Typ); + return Create_Value_Float (abs Operand.Val.Fp, Oper_Typ); when Iir_Predefined_Ieee_1164_Condition_Operator => -- Constant std_logic: need to convert. @@ -995,20 +987,20 @@ package body Synth.Static_Oper is Val : Uns32; Zx : Uns32; begin - From_Std_Logic (Operand.Scal, Val, Zx); + From_Std_Logic (Operand.Val.Scal, Val, Zx); return Create_Value_Discrete (Boolean'Pos (Val = 1 and Zx = 0), Boolean_Type); end; when Iir_Predefined_Ieee_Numeric_Std_Neg_Sgn => declare - Op_Arr : Std_Logic_Vector (1 .. Natural (Operand.Arr.Len)); + Op_Arr : Std_Logic_Vector (1 .. Natural (Operand.Val.Arr.Len)); begin To_Std_Logic_Vector (Operand, Op_Arr); declare Res_Arr : constant Std_Logic_Vector := Neg_Sgn (Op_Arr); begin - return To_Value_Acc (Res_Arr, Operand.Typ.Vec_El); + return To_Valtyp (Res_Arr, Operand.Typ.Vec_El); end; end; @@ -1035,7 +1027,7 @@ package body Synth.Static_Oper is end Synth_Static_Monadic_Predefined; function Eval_To_Vector (Arg : Uns64; Sz : Int64; Res_Type : Type_Acc) - return Value_Acc + return Valtyp is Len : constant Iir_Index32 := Iir_Index32 (Sz); El_Type : constant Type_Acc := Get_Array_Element (Res_Type); @@ -1108,7 +1100,7 @@ package body Synth.Static_Oper is end Eval_Signed_To_Integer; function Synth_Static_Predefined_Function_Call - (Subprg_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc + (Subprg_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is Imp : constant Node := Get_Implementation (Expr); Def : constant Iir_Predefined_Functions := @@ -1121,21 +1113,21 @@ package body Synth.Static_Oper is begin Inter := Inter_Chain; if Inter /= Null_Node then - Param1 := Get_Value (Subprg_Inst, Inter); + Param1 := Get_Value (Subprg_Inst, Inter).Val; Strip_Const (Param1); Inter := Get_Chain (Inter); else Param1 := null; end if; if Inter /= Null_Node then - Param2 := Get_Value (Subprg_Inst, Inter); + Param2 := Get_Value (Subprg_Inst, Inter).Val; Strip_Const (Param2); Inter := Get_Chain (Inter); else Param2 := null; end if; - Res_Typ := Get_Value_Type (Subprg_Inst, Get_Type (Imp)); + Res_Typ := Get_Subtype_Object (Subprg_Inst, Get_Type (Imp)); case Def is when Iir_Predefined_Endfile => @@ -1224,7 +1216,7 @@ package body Synth.Static_Oper is Error_Msg_Synth (+Expr, "unhandled (static) function: " & Iir_Predefined_Functions'Image (Def)); - return null; + return No_Valtyp; end case; end Synth_Static_Predefined_Function_Call; diff --git a/src/synth/synth-static_oper.ads b/src/synth/synth-static_oper.ads index 4c2e51695..dd8b08ad5 100644 --- a/src/synth/synth-static_oper.ads +++ b/src/synth/synth-static_oper.ads @@ -25,15 +25,15 @@ with Vhdl.Nodes; use Vhdl.Nodes; package Synth.Static_Oper is function Synth_Static_Dyadic_Predefined (Syn_Inst : Synth_Instance_Acc; Imp : Node; - Left : Value_Acc; - Right : Value_Acc; - Expr : Node) return Value_Acc; + Left : Valtyp; + Right : Valtyp; + Expr : Node) return Valtyp; function Synth_Static_Monadic_Predefined (Syn_Inst : Synth_Instance_Acc; Imp : Node; - Operand : Value_Acc; - Expr : Node) return Value_Acc; + Operand : Valtyp; + Expr : Node) return Valtyp; function Synth_Static_Predefined_Function_Call - (Subprg_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + (Subprg_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; end Synth.Static_Oper; diff --git a/src/synth/synth-static_proc.adb b/src/synth/synth-static_proc.adb index f0a09a172..be0475b4a 100644 --- a/src/synth/synth-static_proc.adb +++ b/src/synth/synth-static_proc.adb @@ -30,10 +30,10 @@ package body Synth.Static_Proc is procedure Synth_Deallocate (Syn_Inst : Synth_Instance_Acc; Imp : Node) is Inter : constant Node := Get_Interface_Declaration_Chain (Imp); - Param : constant Value_Acc := Get_Value (Syn_Inst, Inter); + Param : constant Valtyp := Get_Value (Syn_Inst, Inter); begin - Synth.Heap.Synth_Deallocate (Param.Acc); - Param.Acc := Null_Heap_Index; + Synth.Heap.Synth_Deallocate (Param.Val.Acc); + Param.Val.Acc := Null_Heap_Index; end Synth_Deallocate; procedure Synth_Static_Procedure (Syn_Inst : Synth_Instance_Acc; diff --git a/src/synth/synth-stmts.adb b/src/synth/synth-stmts.adb index 6c3974a16..80d650b66 100644 --- a/src/synth/synth-stmts.adb +++ b/src/synth/synth-stmts.adb @@ -67,7 +67,7 @@ package body Synth.Stmts is function Synth_Waveform (Syn_Inst : Synth_Instance_Acc; Wf : Node; - Targ_Type : Type_Acc) return Value_Acc is + Targ_Type : Type_Acc) return Valtyp is begin if Get_Kind (Wf) = Iir_Kind_Unaffected_Waveform then -- TODO @@ -91,11 +91,11 @@ package body Synth.Stmts is procedure Synth_Assign (Wid : Wire_Id; Typ : Type_Acc; - Val : Value_Acc; + Val : Valtyp; Offset : Uns32; Loc : Source.Syn_Src) is begin - if Val = null then + if Val = No_Valtyp then return; end if; Phi_Assign (Build_Context, Wid, @@ -105,17 +105,16 @@ package body Synth.Stmts is procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; Pfx : Node; - Dest_Obj : out Value_Acc; + Dest_Valtyp : out Valtyp; Dest_Off : out Uns32; Dest_Voff : out Net; - Dest_Rdwd : out Width; - Dest_Type : out Type_Acc) is + Dest_Rdwd : out Width) is begin case Get_Kind (Pfx) is when Iir_Kind_Simple_Name => Synth_Assignment_Prefix (Syn_Inst, Get_Named_Entity (Pfx), - Dest_Obj, Dest_Off, - Dest_Voff, Dest_Rdwd, Dest_Type); + Dest_Valtyp, Dest_Off, + Dest_Voff, Dest_Rdwd); when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Variable_Declaration | Iir_Kind_Interface_Variable_Declaration @@ -127,27 +126,25 @@ package body Synth.Stmts is | Iir_Kind_Interface_File_Declaration | Iir_Kind_Object_Alias_Declaration => declare - Targ : constant Value_Acc := Get_Value (Syn_Inst, Pfx); + Targ : constant Valtyp := Get_Value (Syn_Inst, Pfx); begin Dest_Voff := No_Net; Dest_Rdwd := 0; - Dest_Type := Targ.Typ; - if Targ.Kind = Value_Alias then + if Targ.Val.Kind = Value_Alias then -- Replace alias by the aliased name. - Dest_Obj := Targ.A_Obj; - Dest_Off := Targ.A_Off; + Dest_Valtyp := (Targ.Typ, Targ.Val.A_Obj); + Dest_Off := Targ.Val.A_Off; else - Dest_Obj := Targ; + Dest_Valtyp := Targ; Dest_Off := 0; end if; end; when Iir_Kind_Function_Call => - Dest_Obj := Synth_Expression (Syn_Inst, Pfx); + Dest_Valtyp := Synth_Expression (Syn_Inst, Pfx); Dest_Off := 0; Dest_Voff := No_Net; Dest_Rdwd := 0; - Dest_Type := Dest_Obj.Typ; when Iir_Kind_Indexed_Name => declare Voff : Net; @@ -157,12 +154,13 @@ package body Synth.Stmts is begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type); - Strip_Const (Dest_Obj); - Dest_W := Dest_Type.W; - Synth_Indexed_Name (Syn_Inst, Pfx, Dest_Type, Voff, Off, W); + Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); + Strip_Const (Dest_Valtyp); + Dest_W := Dest_Valtyp.Typ.W; + Synth_Indexed_Name + (Syn_Inst, Pfx, Dest_Valtyp.Typ, Voff, Off, W); - Dest_Type := Get_Array_Element (Dest_Type); + Dest_Valtyp.Typ := Get_Array_Element (Dest_Valtyp.Typ); if Voff /= No_Net then Dest_Off := Dest_Off + Off; @@ -179,9 +177,10 @@ package body Synth.Stmts is if Dest_Voff = No_Net then -- For constant objects, directly return the indexed -- object. - Strip_Const (Dest_Obj); - if Dest_Obj.Kind in Value_Array .. Value_Const_Array then - Dest_Obj := Dest_Obj.Arr.V + if Dest_Valtyp.Val.Kind + in Value_Array .. Value_Const_Array + then + Dest_Valtyp.Val := Dest_Valtyp.Val.Arr.V (Iir_Index32 ((Dest_W - Dest_Off) / W)); Dest_Off := 0; Dest_W := W; @@ -197,19 +196,20 @@ package body Synth.Stmts is begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type); + Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); if Dest_Off /= 0 and then Dest_Voff /= No_Net then -- TODO. raise Internal_Error; end if; - Strip_Const (Dest_Obj); - if Dest_Obj.Kind = Value_Const_Record then + Strip_Const (Dest_Valtyp); + if Dest_Valtyp.Val.Kind = Value_Const_Record then + -- Return the selected element. pragma Assert (Dest_Off = 0); - Dest_Obj := Dest_Obj.Rec.V (Idx + 1); + Dest_Valtyp.Val := Dest_Valtyp.Val.Rec.V (Idx + 1); else - Dest_Off := Dest_Off + Dest_Type.Rec.E (Idx + 1).Off; + Dest_Off := Dest_Off + Dest_Valtyp.Typ.Rec.E (Idx + 1).Off; end if; - Dest_Type := Dest_Type.Rec.E (Idx + 1).Typ; + Dest_Valtyp.Typ := Dest_Valtyp.Typ.Rec.E (Idx + 1).Typ; end; when Iir_Kind_Slice_Name => @@ -223,10 +223,11 @@ package body Synth.Stmts is begin Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type); - Strip_Const (Dest_Obj); + Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); + Strip_Const (Dest_Valtyp); - Get_Onedimensional_Array_Bounds (Dest_Type, Pfx_Bnd, El_Typ); + Get_Onedimensional_Array_Bounds + (Dest_Valtyp.Typ, Pfx_Bnd, El_Typ); Synth_Slice_Suffix (Syn_Inst, Pfx, Pfx_Bnd, El_Typ.W, Res_Bnd, Sl_Voff, Sl_Off, Wd); @@ -237,19 +238,21 @@ package body Synth.Stmts is Dest_Voff := Build_Addidx (Get_Build (Syn_Inst), Dest_Voff, Sl_Voff); else - Dest_Rdwd := Dest_Type.W; + Dest_Rdwd := Dest_Valtyp.Typ.W; Dest_Voff := Sl_Voff; end if; - Dest_Type := Create_Slice_Type (Wd, El_Typ); + Dest_Valtyp.Typ := Create_Slice_Type (Wd, El_Typ); else -- Fixed slice. - Dest_Type := - Create_Onedimensional_Array_Subtype (Dest_Type, Res_Bnd); + Dest_Valtyp.Typ := Create_Onedimensional_Array_Subtype + (Dest_Valtyp.Typ, Res_Bnd); if Dest_Voff /= No_Net then -- Slice of a memory. Dest_Off := Dest_Off + Sl_Off; else - if Dest_Obj.Kind in Value_Array .. Value_Const_Array then + if Dest_Valtyp.Val.Kind + in Value_Array .. Value_Const_Array + then declare Arr : Value_Array_Acc; Off : Iir_Index32; @@ -265,14 +268,14 @@ package body Synth.Stmts is Off := Iir_Index32 (Pfx_Bnd.Left - Res_Bnd.Left); end case; - Arr.V := Dest_Obj.Arr.V + Arr.V := Dest_Valtyp.Val.Arr.V (Off + 1 .. Off + Iir_Index32 (Res_Bnd.Len)); - if Dest_Obj.Kind = Value_Array then - Dest_Obj := Create_Value_Array - (Dest_Type, Arr); + if Dest_Valtyp.Val.Kind = Value_Array then + Dest_Valtyp.Val := Create_Value_Array + (Dest_Valtyp.Typ, Arr); else - Dest_Obj := Create_Value_Const_Array - (Dest_Type, Arr); + Dest_Valtyp.Val := Create_Value_Const_Array + (Dest_Valtyp.Typ, Arr); end if; end; else @@ -287,12 +290,11 @@ package body Synth.Stmts is | Iir_Kind_Dereference => Synth_Assignment_Prefix (Syn_Inst, Get_Prefix (Pfx), - Dest_Obj, Dest_Off, Dest_Voff, Dest_Rdwd, Dest_Type); + Dest_Valtyp, Dest_Off, Dest_Voff, Dest_Rdwd); if Dest_Off /= 0 and then Dest_Voff /= No_Net then raise Internal_Error; end if; - Dest_Obj := Heap.Synth_Dereference (Dest_Obj.Acc); - Dest_Type := Dest_Obj.Typ; + Dest_Valtyp := Heap.Synth_Dereference (Dest_Valtyp.Val.Acc); when others => Error_Kind ("synth_assignment_prefix", Pfx); @@ -342,7 +344,7 @@ package body Synth.Stmts is Bnd : Bound_Type; begin Base_Typ := - Get_Value_Type (Syn_Inst, Get_Base_Type (Targ_Type)); + Get_Subtype_Object (Syn_Inst, Get_Base_Type (Targ_Type)); case Base_Typ.Kind is when Type_Unbounded_Vector => Bnd := Expr.Synth_Array_Bounds (Syn_Inst, Targ_Type, 1); @@ -364,25 +366,23 @@ package body Synth.Stmts is | Iir_Kind_Slice_Name | Iir_Kind_Dereference => declare - Obj : Value_Acc; + Vt : Valtyp; Off : Uns32; - Typ : Type_Acc; Voff : Net; Rdwd : Width; begin - Synth_Assignment_Prefix (Syn_Inst, Target, - Obj, Off, Voff, Rdwd, Typ); + Synth_Assignment_Prefix (Syn_Inst, Target, Vt, Off, Voff, Rdwd); if Voff = No_Net then -- FIXME: check index. return Target_Info'(Kind => Target_Simple, - Targ_Type => Typ, - Obj => Obj, + Targ_Type => Vt.Typ, + Obj => Vt.Val, Off => Off); else return Target_Info'(Kind => Target_Memory, - Targ_Type => Typ, - Mem_Obj => Obj, + Targ_Type => Vt.Typ, + Mem_Obj => Vt.Val, Mem_Mwidth => Rdwd, Mem_Moff => 0, Mem_Voff => Voff, @@ -423,18 +423,18 @@ package body Synth.Stmts is procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Target_Info; - Val : Value_Acc; + Val : Valtyp; Loc : Node); -- Extract a part of VAL from a target aggregate at offset OFF (offset -- in the array). function Aggregate_Extract - (Val : Value_Acc; Off : Uns32; Typ : Type_Acc; Loc : Node) - return Value_Acc + (Val : Valtyp; Off : Uns32; Typ : Type_Acc; Loc : Node) + return Valtyp is El_Typ : constant Type_Acc := Get_Array_Element (Val.Typ); begin - case Val.Kind is + case Val.Val.Kind is when Value_Array | Value_Const_Array => if Typ /= El_Typ then @@ -442,7 +442,8 @@ package body Synth.Stmts is raise Internal_Error; end if; pragma Assert (Val.Typ.Vbound.Len >= Off); - return Val.Arr.V (Iir_Index32 (Val.Typ.Vbound.Len - Off)); + return (El_Typ, + Val.Val.Arr.V (Iir_Index32 (Val.Typ.Vbound.Len - Off))); when Value_Net | Value_Wire => declare @@ -461,7 +462,7 @@ package body Synth.Stmts is procedure Synth_Assignment_Aggregate (Syn_Inst : Synth_Instance_Acc; Target : Node; Target_Typ : Type_Acc; - Val : Value_Acc; + Val : Valtyp; Loc : Node) is Targ_Bnd : constant Bound_Type := Get_Array_Bound (Target_Typ, 1); @@ -495,7 +496,7 @@ package body Synth.Stmts is procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Target_Info; - Val : Value_Acc; + Val : Valtyp; Loc : Node) is begin case Target.Kind is @@ -507,13 +508,13 @@ package body Synth.Stmts is Synth_Assign (Target.Obj.W, Target.Targ_Type, Val, Target.Off, Loc); else - if not Is_Static (Val) then + if not Is_Static (Val.Val) then -- Maybe the error message is too cryptic ? Error_Msg_Synth (+Loc, "cannot assign a net to a static value"); else pragma Assert (Target.Off = 0); - Assign_Value (Target.Obj, Strip_Const (Val), Loc); + Assign_Value (Target.Obj, Strip_Const (Val.Val), Loc); end if; end if; when Target_Memory => @@ -536,7 +537,7 @@ package body Synth.Stmts is procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Node; - Val : Value_Acc; + Val : Valtyp; Loc : Node) is Info : Target_Info; @@ -550,7 +551,7 @@ package body Synth.Stmts is Off : Uns32; Voff : Net; Typ : Type_Acc; - Loc : Node) return Value_Acc + Loc : Node) return Valtyp is N : Net; begin @@ -565,7 +566,7 @@ package body Synth.Stmts is and then Typ /= Get_Array_Element (Obj.Typ) then -- Nothing to do if extracting the whole object as a slice. - return Obj; + return (Typ, Obj); end if; N := Build_Extract (Get_Build (Syn_Inst), Get_Net (Obj), Off, Typ.W); end if; @@ -575,7 +576,7 @@ package body Synth.Stmts is function Synth_Read (Syn_Inst : Synth_Instance_Acc; Targ : Target_Info; - Loc : Node) return Value_Acc + Loc : Node) return Valtyp is N : Net; begin @@ -598,7 +599,7 @@ package body Synth.Stmts is (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Targ : Target_Info; - Val : Value_Acc; + Val : Valtyp; begin Targ := Synth_Target (Syn_Inst, Get_Target (Stmt)); Val := Synth_Waveform @@ -613,7 +614,7 @@ package body Synth.Stmts is Cond : Node; Cwf : Node; Inp : Input; - Val, Cond_Val : Value_Acc; + Val, Cond_Val : Valtyp; Cond_Net : Net; First, Last : Net; V : Net; @@ -629,7 +630,7 @@ package body Synth.Stmts is Cond := Get_Condition (Cwf); if Cond /= Null_Node then Cond_Val := Synth_Expression (Syn_Inst, Cond); - if Cond_Val = null then + if Cond_Val = No_Valtyp then Cond_Net := Build_Const_UB32 (Build_Context, 0, 1); else Cond_Net := Get_Net (Cond_Val); @@ -665,12 +666,12 @@ package body Synth.Stmts is (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Targ : Target_Info; - Val : Value_Acc; + Val : Valtyp; begin Targ := Synth_Target (Syn_Inst, Get_Target (Stmt)); Val := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Stmt), Targ.Targ_Type); - if Val = null then + if Val = No_Valtyp then Set_Error (Syn_Inst); return; end if; @@ -684,11 +685,11 @@ package body Synth.Stmts is Targ_Type : Type_Acc; Cond : Node; Ce : Node; - Val, Cond_Val : Value_Acc; + Val, Cond_Val : Valtyp; V : Net; First, Last : Net; begin - Targ_Type := Get_Value_Type (Syn_Inst, Get_Type (Target)); + Targ_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Target)); Last := No_Net; Ce := Get_Conditional_Expression_Chain (Stmt); while Ce /= Null_Node loop @@ -718,23 +719,23 @@ package body Synth.Stmts is is Cond : constant Node := Get_Condition (Stmt); Els : constant Node := Get_Else_Clause (Stmt); - Cond_Val : Value_Acc; + Cond_Val : Valtyp; Phi_True : Phi_Type; Phi_False : Phi_Type; begin Cond_Val := Synth_Expression (C.Inst, Cond); - if Cond_Val = null then + if Cond_Val = No_Valtyp then Set_Error (C.Inst); return; end if; - if Is_Static (Cond_Val) then + if Is_Static (Cond_Val.Val) then Strip_Const (Cond_Val); - if Cond_Val.Scal = 1 then + if Cond_Val.Val.Scal = 1 then -- True. Synth_Sequential_Statements (C, Get_Sequential_Statement_Chain (Stmt)); else - pragma Assert (Cond_Val.Scal = 0); + pragma Assert (Cond_Val.Val.Scal = 0); if Is_Valid (Els) then -- Else part if Is_Null (Get_Condition (Els)) then @@ -775,7 +776,7 @@ package body Synth.Stmts is function Convert_To_Uns64 (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Uns64 is - Expr_Val : Value_Acc; + Expr_Val : Valtyp; Vec : Logvec_Array (0 .. 1); Off : Uns32; Has_Zx : Boolean; @@ -784,7 +785,7 @@ package body Synth.Stmts is Off := 0; Has_Zx := False; Vec := (others => (0, 0)); - Value2logvec (Expr_Val, Vec, Off, Has_Zx); + Value2logvec (Expr_Val.Val, Vec, Off, Has_Zx); if Has_Zx then Error_Msg_Synth (+Expr, "meta-values never match"); end if; @@ -1100,7 +1101,7 @@ package body Synth.Stmts is Choice : Node; Stmts : Node; Sel_Expr : Node; - Sel_Val : Value_Acc; + Sel_Val : Valtyp; begin -- Synth statements, extract choice value. Stmts := Null_Node; @@ -1115,7 +1116,7 @@ package body Synth.Stmts is when Iir_Kind_Choice_By_Expression => Sel_Expr := Get_Choice_Expression (Choice); Sel_Val := Synth_Expression_With_Basetype (C.Inst, Sel_Expr); - if Is_Equal (Sel_Val, Sel) then + if Is_Equal (Sel_Val.Val, Sel) then Synth_Sequential_Statements (C, Stmts); exit; end if; @@ -1184,24 +1185,24 @@ package body Synth.Stmts is procedure Synth_Case_Statement (C : in out Seq_Context; Stmt : Node) is Expr : constant Node := Get_Expression (Stmt); - Sel : Value_Acc; + Sel : Valtyp; begin Sel := Synth_Expression_With_Basetype (C.Inst, Expr); Strip_Const (Sel); - if Is_Static (Sel) then + if Is_Static (Sel.Val) then case Sel.Typ.Kind is when Type_Bit | Type_Logic | Type_Discrete => - Synth_Case_Statement_Static_Scalar (C, Stmt, Sel.Scal); + Synth_Case_Statement_Static_Scalar (C, Stmt, Sel.Val.Scal); when Type_Vector | Type_Array => - Synth_Case_Statement_Static_Array (C, Stmt, Sel); + Synth_Case_Statement_Static_Array (C, Stmt, Sel.Val); when others => raise Internal_Error; end case; else - Synth_Case_Statement_Dynamic (C, Stmt, Sel); + Synth_Case_Statement_Dynamic (C, Stmt, Sel.Val); end if; end Synth_Case_Statement; @@ -1231,7 +1232,7 @@ package body Synth.Stmts is Case_El : Case_Element_Array_Acc; - Sel : Value_Acc; + Sel : Valtyp; Sel_Net : Net; begin Targ := Synth_Target (Syn_Inst, Get_Target (Stmt)); @@ -1525,7 +1526,7 @@ package body Synth.Stmts is Inter_Type : Type_Acc; Assoc : Node; Actual : Node; - Val : Value_Acc; + Val : Valtyp; Nbr_Inout : Natural; Iterator : Association_Iterator; Info : Target_Info; @@ -1540,7 +1541,7 @@ package body Synth.Stmts is Association_Iterate_Next (Iterator, Inter, Assoc); exit when Inter = Null_Node; - Inter_Type := Get_Value_Type (Caller_Inst, Get_Type (Inter)); + Inter_Type := Get_Subtype_Object (Caller_Inst, Get_Type (Inter)); case Iir_Parameter_Modes (Get_Mode (Inter)) is when Iir_In_Mode => @@ -1579,7 +1580,7 @@ package body Synth.Stmts is if Info.Off /= 0 then raise Internal_Error; end if; - Val := Info.Obj; + Val := (Info.Targ_Type, Info.Obj); else Val := Synth_Read (Caller_Inst, Info, Assoc); end if; @@ -1591,13 +1592,13 @@ package body Synth.Stmts is Val := Create_Value_Alias (Info.Obj, Info.Off, Info.Targ_Type); when Iir_Kind_Interface_File_Declaration => - Val := Info.Obj; + Val := (Info.Targ_Type, Info.Obj); when Iir_Kind_Interface_Quantity_Declaration => raise Internal_Error; end case; end case; - if Val = null then + if Val = No_Valtyp then Set_Error (Subprg_Inst); return; end if; @@ -1605,7 +1606,8 @@ package body Synth.Stmts is -- FIXME: conversion only for constants, reshape for all. Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc); - if Get_Instance_Const (Subprg_Inst) and then not Is_Static (Val) then + if Get_Instance_Const (Subprg_Inst) and then not Is_Static (Val.Val) + then Set_Instance_Const (Subprg_Inst, False); end if; @@ -1615,8 +1617,9 @@ package body Synth.Stmts is Create_Object (Subprg_Inst, Inter, Val); when Iir_Kind_Interface_Variable_Declaration => -- Arguments are passed by copy. - if Is_Static (Val) or else Get_Mode (Inter) = Iir_In_Mode then - Val := Unshare (Val, Current_Pool); + if Is_Static (Val.Val) or else Get_Mode (Inter) = Iir_In_Mode + then + Val.Val := Unshare (Val.Val, Current_Pool); else -- Will be changed to a wire. null; @@ -1664,14 +1667,14 @@ package body Synth.Stmts is if Get_Mode (Inter) in Iir_Out_Modes and then Get_Kind (Inter) = Iir_Kind_Interface_Variable_Declaration then - Val := Get_Value (Subprg_Inst, Inter); + Val := Get_Value (Subprg_Inst, Inter).Val; -- Arguments are passed by copy. Wire := Alloc_Wire (Wire_Variable, Inter); Set_Wire_Gate (Wire, Get_Net (Val)); Val := Create_Value_Wire (Wire, Val.Typ); - Create_Object_Force (Subprg_Inst, Inter, null); - Create_Object_Force (Subprg_Inst, Inter, Val); + Create_Object_Force (Subprg_Inst, Inter, No_Valtyp); + Create_Object_Force (Subprg_Inst, Inter, (Val.Typ, Val)); end if; end loop; end Synth_Subprogram_Association_Wires; @@ -1686,7 +1689,7 @@ package body Synth.Stmts is Inter : Node; Assoc : Node; Assoc_Inter : Node; - Val : Value_Acc; + Val : Valtyp; Nbr_Inout : Natural; begin Nbr_Inout := 0; @@ -1705,9 +1708,9 @@ package body Synth.Stmts is Synth_Assignment (Caller_Inst, Infos (Nbr_Inout), Val, Assoc); -- Free wire used for out/inout interface variables. - if Val.Kind = Value_Wire then - Phi_Discard_Wires (Val.W, No_Wire_Id); - Free_Wire (Val.W); + if Val.Val.Kind = Value_Wire then + Phi_Discard_Wires (Val.Val.W, No_Wire_Id); + Free_Wire (Val.Val.W); end if; end if; @@ -1721,12 +1724,12 @@ package body Synth.Stmts is Call : Node; Init : Association_Iterator_Init; Infos : Target_Info_Array) - return Value_Acc + return Valtyp is Imp : constant Node := Get_Implementation (Call); Is_Func : constant Boolean := Is_Function_Declaration (Imp); Bod : constant Node := Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp); - Res : Value_Acc; + Res : Valtyp; C : Seq_Context (Mode_Dynamic); Wire_Mark : Wire_Id; Subprg_Phi : Phi_Type; @@ -1739,7 +1742,7 @@ package body Synth.Stmts is W_Ret => No_Wire_Id, W_Val => No_Wire_Id, Ret_Init => No_Net, - Ret_Value => null, + Ret_Value => No_Valtyp, Ret_Typ => null, Nbr_Ret => 0); @@ -1756,7 +1759,7 @@ package body Synth.Stmts is if Is_Func then -- Set a default value for the return. - C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); + C.Ret_Typ := Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp)); Set_Wire_Gate (C.W_Val, Build_Signal (Build_Context, @@ -1782,19 +1785,19 @@ package body Synth.Stmts is end if; if Is_Error (C.Inst) then - Res := null; + Res := No_Valtyp; else if Is_Func then if C.Nbr_Ret = 0 then raise Internal_Error; - elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value) then + elsif C.Nbr_Ret = 1 and then Is_Static (C.Ret_Value.Val) then Res := C.Ret_Value; else Res := Create_Value_Net (Get_Current_Value (Build_Context, C.W_Val), C.Ret_Value.Typ); end if; else - Res := null; + Res := No_Valtyp; Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); end if; end if; @@ -1824,25 +1827,25 @@ package body Synth.Stmts is Call : Node; Init : Association_Iterator_Init; Infos : Target_Info_Array) - return Value_Acc + return Valtyp is Imp : constant Node := Get_Implementation (Call); Is_Func : constant Boolean := Is_Function_Declaration (Imp); Bod : constant Node := Get_Subprogram_Body (Imp); - Res : Value_Acc; + Res : Valtyp; C : Seq_Context (Mode_Static); begin C := (Mode_Static, Inst => Sub_Inst, Cur_Loop => null, S_En => True, - Ret_Value => null, + Ret_Value => No_Valtyp, Ret_Typ => null, Nbr_Ret => 0); if Is_Func then -- Set a default value for the return. - C.Ret_Typ := Get_Value_Type (Syn_Inst, Get_Return_Type (Imp)); + C.Ret_Typ := Get_Subtype_Object (Syn_Inst, Get_Return_Type (Imp)); end if; Decls.Synth_Declarations (C.Inst, Get_Declaration_Chain (Bod), True); @@ -1852,20 +1855,20 @@ package body Synth.Stmts is end if; if Is_Error (C.Inst) then - Res := null; + Res := No_Valtyp; else if Is_Func then if C.Nbr_Ret = 0 then Error_Msg_Synth (+Call, "function call completed without a return statement"); - Res := null; + Res := No_Valtyp; else pragma Assert (C.Nbr_Ret = 1); - pragma Assert (Is_Static (C.Ret_Value)); + pragma Assert (Is_Static (C.Ret_Value.Val)); Res := C.Ret_Value; end if; else - Res := null; + Res := No_Valtyp; Synth_Subprogram_Back_Association (C.Inst, Syn_Inst, Init, Infos); end if; end if; @@ -1879,7 +1882,7 @@ package body Synth.Stmts is function Synth_Subprogram_Call (Syn_Inst : Synth_Instance_Acc; Call : Node; Init : Association_Iterator_Init) - return Value_Acc + return Valtyp is Imp : constant Node := Get_Implementation (Call); Is_Func : constant Boolean := Is_Function_Declaration (Imp); @@ -1887,7 +1890,7 @@ package body Synth.Stmts is Nbr_Inout : constant Natural := Count_Associations (Init); Infos : Target_Info_Array (1 .. Nbr_Inout); Area_Mark : Areapools.Mark_Type; - Res : Value_Acc; + Res : Valtyp; Sub_Inst : Synth_Instance_Acc; Up_Inst : Synth_Instance_Acc; begin @@ -1901,7 +1904,7 @@ package body Synth.Stmts is Synth_Subprogram_Association (Sub_Inst, Syn_Inst, Init, Infos); if Is_Error (Sub_Inst) then - Res := null; + Res := No_Valtyp; else if not Is_Func then if Get_Purity_State (Imp) /= Pure then @@ -1930,7 +1933,7 @@ package body Synth.Stmts is end Synth_Subprogram_Call; function Synth_Subprogram_Call - (Syn_Inst : Synth_Instance_Acc; Call : Node) return Value_Acc + (Syn_Inst : Synth_Instance_Acc; Call : Node) return Valtyp is Imp : constant Node := Get_Implementation (Call); Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); @@ -1944,7 +1947,7 @@ package body Synth.Stmts is function Synth_User_Operator (Syn_Inst : Synth_Instance_Acc; Left_Expr : Node; Right_Expr : Node; - Expr : Node) return Value_Acc + Expr : Node) return Valtyp is Imp : constant Node := Get_Implementation (Expr); Inter_Chain : constant Node := Get_Interface_Declaration_Chain (Imp); @@ -1985,7 +1988,7 @@ package body Synth.Stmts is is Call : constant Node := Get_Procedure_Call (Stmt); Imp : constant Node := Get_Implementation (Call); - Res : Value_Acc; + Res : Valtyp; begin case Get_Implicit_Definition (Imp) is when Iir_Predefined_None => @@ -1994,7 +1997,7 @@ package body Synth.Stmts is (+Stmt, "call to foreign %n is not supported", +Imp); else Res := Synth_Subprogram_Call (Syn_Inst, Call); - pragma Assert (Res = null); + pragma Assert (Res = No_Valtyp); end if; when others => Synth_Implicit_Procedure_Call (Syn_Inst, Call); @@ -2142,16 +2145,15 @@ package body Synth.Stmts is Static_Cond : Boolean; Loop_Label : Node; Lc : Loop_Context_Acc; - Cond_Val : Value_Acc; + Cond_Val : Valtyp; Phi_True : Phi_Type; Phi_False : Phi_Type; begin - if Cond /= Null_Node then Cond_Val := Synth_Expression (C.Inst, Cond); - Static_Cond := Is_Static_Val (Cond_Val); + Static_Cond := Is_Static_Val (Cond_Val.Val); if Static_Cond then - if Get_Static_Discrete (Cond_Val) = 0 then + if Get_Static_Discrete (Cond_Val.Val) = 0 then -- Not executed. return; end if; @@ -2202,13 +2204,12 @@ package body Synth.Stmts is Is_Exit : constant Boolean := Get_Kind (Stmt) = Iir_Kind_Exit_Statement; Loop_Label : Node; Lc : Loop_Context_Acc; - Cond_Val : Value_Acc; + Cond_Val : Valtyp; begin - if Cond /= Null_Node then Cond_Val := Synth_Expression (C.Inst, Cond); - pragma Assert (Is_Static_Val (Cond_Val)); - if Get_Static_Discrete (Cond_Val) = 0 then + pragma Assert (Is_Static_Val (Cond_Val.Val)); + if Get_Static_Discrete (Cond_Val.Val) = 0 then -- Not executed. return; end if; @@ -2252,9 +2253,9 @@ package body Synth.Stmts is end if; -- Initial value. - It_Rng := Get_Value_Type (C.Inst, Get_Type (Iterator)); + It_Rng := Get_Subtype_Object (C.Inst, Get_Type (Iterator)); Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); - Create_Object (C.Inst, Iterator, Val); + Create_Object (C.Inst, Iterator, (It_Rng, Val)); end Init_For_Loop_Statement; procedure Finish_For_Loop_Statement (C : in out Seq_Context; @@ -2346,7 +2347,7 @@ package body Synth.Stmts is Bit0 : constant Net := Get_Inst_Bit0 (C.Inst); Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt); Cond : constant Node := Get_Condition (Stmt); - Val : Value_Acc; + Val : Valtyp; Lc : aliased Loop_Context (Mode_Dynamic); begin Lc := (Mode => Mode_Dynamic, @@ -2364,11 +2365,11 @@ package body Synth.Stmts is loop if Cond /= Null_Node then Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type); - if not Is_Static (Val) then + if not Is_Static (Val.Val) then Error_Msg_Synth (+Cond, "loop condition must be static"); exit; end if; - exit when Val.Scal = 0; + exit when Val.Val.Scal = 0; end if; Synth_Sequential_Statements (C, Stmts); @@ -2402,7 +2403,7 @@ package body Synth.Stmts is is Stmts : constant Node := Get_Sequential_Statement_Chain (Stmt); Cond : constant Node := Get_Condition (Stmt); - Val : Value_Acc; + Val : Valtyp; Lc : aliased Loop_Context (Mode_Static); begin Lc := (Mode => Mode_Static, @@ -2415,8 +2416,8 @@ package body Synth.Stmts is loop if Cond /= Null_Node then Val := Synth_Expression_With_Type (C.Inst, Cond, Boolean_Type); - pragma Assert (Is_Static (Val)); - exit when Val.Scal = 0; + pragma Assert (Is_Static (Val.Val)); + exit when Val.Val.Scal = 0; end if; Synth_Sequential_Statements (C, Stmts); @@ -2432,13 +2433,13 @@ package body Synth.Stmts is procedure Synth_Return_Statement (C : in out Seq_Context; Stmt : Node) is Is_Dyn : constant Boolean := not Get_Instance_Const (C.Inst); - Val : Value_Acc; + Val : Valtyp; Expr : constant Node := Get_Expression (Stmt); begin if Expr /= Null_Node then -- Return in function. Val := Synth_Expression_With_Type (C.Inst, Expr, C.Ret_Typ); - if Val = null then + if Val = No_Valtyp then Set_Error (C.Inst); return; end if; @@ -2486,13 +2487,13 @@ package body Synth.Stmts is Get_Kind (Stmt) = Iir_Kind_Report_Statement; Rep_Expr : constant Node := Get_Report_Expression (Stmt); Sev_Expr : constant Node := Get_Severity_Expression (Stmt); - Rep : Value_Acc; - Sev : Value_Acc; + Rep : Valtyp; + Sev : Valtyp; Sev_V : Natural; begin if Rep_Expr /= Null_Node then Rep := Synth_Expression_With_Basetype (C.Inst, Rep_Expr); - if Rep = null then + if Rep = No_Valtyp then Set_Error (C.Inst); return; end if; @@ -2500,7 +2501,7 @@ package body Synth.Stmts is end if; if Sev_Expr /= Null_Node then Sev := Synth_Expression (C.Inst, Sev_Expr); - if Sev = null then + if Sev = No_Valtyp then Set_Error (C.Inst); return; end if; @@ -2515,14 +2516,14 @@ package body Synth.Stmts is Put_Err ("assertion"); end if; Put_Err (' '); - if Sev = null then + if Sev = No_Valtyp then if Is_Report then Sev_V := 0; else Sev_V := 2; end if; else - Sev_V := Natural (Sev.Scal); + Sev_V := Natural (Sev.Val.Scal); end if; case Sev_V is when 0 => @@ -2538,7 +2539,7 @@ package body Synth.Stmts is end case; Put_Err ("): "); - Put_Line_Err (Value_To_String (Rep)); + Put_Line_Err (Value_To_String (Rep.Val)); end Synth_Static_Report; procedure Synth_Static_Report_Statement @@ -2550,16 +2551,16 @@ package body Synth.Stmts is procedure Synth_Static_Assertion_Statement (C : in out Seq_Context; Stmt : Node) is - Cond : Value_Acc; + Cond : Valtyp; begin Cond := Synth_Expression (C.Inst, Get_Assertion_Condition (Stmt)); - if Cond = null then + if Cond = No_Valtyp then Set_Error (C.Inst); return; end if; - pragma Assert (Is_Static (Cond)); + pragma Assert (Is_Static (Cond.Val)); Strip_Const (Cond); - if Cond.Scal = 1 then + if Cond.Val.Scal = 1 then return; end if; Synth_Static_Report (C, Stmt); @@ -2681,7 +2682,7 @@ package body Synth.Stmts is is Stmt : Node; Cond : Node; - Cond_Val : Value_Acc; + Cond_Val : Valtyp; Phi_True : Phi_Type; Phi_False : Phi_Type; begin @@ -2734,7 +2735,7 @@ package body Synth.Stmts is W_Ret => No_Wire_Id, W_Val => No_Wire_Id, Ret_Init => No_Net, - Ret_Value => null, + Ret_Value => No_Valtyp, Ret_Typ => null, Nbr_Ret => 0); @@ -2768,7 +2769,7 @@ package body Synth.Stmts is end Synth_Process_Statement; function Synth_User_Function_Call - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc is + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp is begin -- Is it a call to an ieee function ? declare @@ -2787,7 +2788,7 @@ package body Synth.Stmts is Error_Msg_Synth (+Expr, "unhandled call to ieee function %i", +Imp); Set_Error (Syn_Inst); - return null; + return No_Valtyp; end if; end if; end if; @@ -2800,16 +2801,16 @@ package body Synth.Stmts is (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Cond : constant Node := Get_Assertion_Condition (Stmt); - Val : Value_Acc; + Val : Valtyp; Inst : Instance; begin Val := Synth_Expression (Syn_Inst, Cond); - if Val = null then + if Val = No_Valtyp then Set_Error (Syn_Inst); return; end if; - if Is_Static (Val) then - if Val.Scal /= 1 then + if Is_Static (Val.Val) then + if Val.Val.Scal /= 1 then Error_Msg_Synth (+Stmt, "assertion failure"); end if; return; @@ -3131,7 +3132,7 @@ package body Synth.Stmts is if Iterator /= Null_Node then -- Add the iterator (for for-generate). - Create_Object (Bod_Inst, Iterator, Iterator_Val); + Create_Object (Bod_Inst, Iterator, (Iterator_Val.Typ, Iterator_Val)); end if; Synth_Declarations (Bod_Inst, Decls_Chain); @@ -3150,7 +3151,7 @@ package body Synth.Stmts is Gen : Node; Bod : Node; Icond : Node; - Cond : Value_Acc; + Cond : Valtyp; Name : Sname; begin Gen := Stmt; @@ -3160,12 +3161,12 @@ package body Synth.Stmts is if Icond /= Null_Node then Cond := Synth_Expression (Syn_Inst, Icond); Strip_Const (Cond); - pragma Assert (Cond.Kind = Value_Discrete); + pragma Assert (Cond.Val.Kind = Value_Discrete); else -- It is the else generate. - Cond := null; + Cond := No_Valtyp; end if; - if Cond = null or else Cond.Scal = 1 then + if Cond = No_Valtyp or else Cond.Val.Scal = 1 then Bod := Get_Generate_Statement_Body (Gen); Apply_Block_Configuration (Get_Generate_Block_Configuration (Bod), Bod); @@ -3195,7 +3196,7 @@ package body Synth.Stmts is end if; -- Initial value. - It_Rng := Get_Value_Type (Syn_Inst, Get_Type (Iterator)); + It_Rng := Get_Subtype_Object (Syn_Inst, Get_Type (Iterator)); Val := Create_Value_Discrete (It_Rng.Drange.Left, It_Rng); Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); @@ -3316,8 +3317,7 @@ package body Synth.Stmts is is Spec : constant Node := Get_Attribute_Specification (Val); Sig : constant Node := Get_Designated_Entity (Val); - V : Value_Acc; - Targ : Value_Acc; + V : Valtyp; begin -- The type must be boolean if (Get_Base_Type (Get_Type (Val)) /= @@ -3338,7 +3338,7 @@ package body Synth.Stmts is -- The value must be true V := Synth_Expression_With_Type (Syn_Inst, Get_Expression (Spec), Boolean_Type); - if V.Scal /= 1 then + if V.Val.Scal /= 1 then return; end if; @@ -3346,16 +3346,16 @@ package body Synth.Stmts is Off : Uns32; Voff : Net; Wd : Width; - Typ : Type_Acc; N : Net; + Vt : Valtyp; begin - Synth_Assignment_Prefix (Syn_Inst, Sig, Targ, Off, Voff, Wd, Typ); + Synth_Assignment_Prefix (Syn_Inst, Sig, Vt, Off, Voff, Wd); pragma Assert (Off = 0); pragma Assert (Voff = No_Net); - pragma Assert (Targ.Kind = Value_Wire); + pragma Assert (Vt.Val.Kind = Value_Wire); - N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Typ.W); - Add_Conc_Assign (Targ.W, N, 0, Val); + N := Build_Formal_Input (Get_Build (Syn_Inst), Id, Vt.Typ.W); + Add_Conc_Assign (Vt.Val.W, N, 0, Val); end; end Synth_Attribute_Formal; diff --git a/src/synth/synth-stmts.ads b/src/synth/synth-stmts.ads index fd5090bde..b1514766e 100644 --- a/src/synth/synth-stmts.ads +++ b/src/synth/synth-stmts.ads @@ -35,15 +35,14 @@ package Synth.Stmts is procedure Synth_Assignment_Prefix (Syn_Inst : Synth_Instance_Acc; Pfx : Node; - Dest_Obj : out Value_Acc; + Dest_Valtyp : out Valtyp; Dest_Off : out Uns32; Dest_Voff : out Net; - Dest_Rdwd : out Width; - Dest_Type : out Type_Acc); + Dest_Rdwd : out Width); procedure Synth_Assignment (Syn_Inst : Synth_Instance_Acc; Target : Node; - Val : Value_Acc; + Val : Valtyp; Loc : Node); function Synth_Read_Memory (Syn_Inst : Synth_Instance_Acc; @@ -51,16 +50,16 @@ package Synth.Stmts is Off : Uns32; Voff : Net; Typ : Type_Acc; - Loc : Node) return Value_Acc; + Loc : Node) return Valtyp; function Synth_User_Function_Call - (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Value_Acc; + (Syn_Inst : Synth_Instance_Acc; Expr : Node) return Valtyp; -- Operation implemented by a user function. function Synth_User_Operator (Syn_Inst : Synth_Instance_Acc; Left_Expr : Node; Right_Expr : Node; - Expr : Node) return Value_Acc; + Expr : Node) return Valtyp; -- Generate netlists for concurrent statements STMTS. procedure Synth_Concurrent_Statements @@ -120,7 +119,7 @@ private Cur_Loop : Loop_Context_Acc; - Ret_Value : Value_Acc; + Ret_Value : Valtyp; Ret_Typ : Type_Acc; Nbr_Ret : Int32; diff --git a/src/synth/synth-values.adb b/src/synth/synth-values.adb index 2fbdd0d6a..45986eed1 100644 --- a/src/synth/synth-values.adb +++ b/src/synth/synth-values.adb @@ -61,10 +61,6 @@ package body Synth.Values is return Is_Static (Val.A_Obj); when Value_Const => return True; - when Value_Instance - | Value_Subtype => - -- Not really a value. - raise Internal_Error; end case; end Is_Static; @@ -91,10 +87,6 @@ package body Synth.Values is return True; when Value_Alias => return Is_Static_Val (Val.A_Obj); - when Value_Instance - | Value_Subtype => - -- Not really a value. - raise Internal_Error; end case; end Is_Static_Val; @@ -138,6 +130,11 @@ package body Synth.Values is end loop; end Strip_Alias_Const; + function Strip_Alias_Const (V : Valtyp) return Valtyp is + begin + return (V.Typ, Strip_Alias_Const (V.Val)); + end Strip_Alias_Const; + function Is_Equal (L, R : Value_Acc) return Boolean is L1 : constant Value_Acc := Strip_Alias_Const (L); @@ -525,6 +522,11 @@ package body Synth.Values is Typ => Wtype))); end Create_Value_Wire; + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp is + begin + return (Wtype, Create_Value_Wire (W, Wtype)); + end Create_Value_Wire; + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Value_Acc is subtype Value_Type_Net is Value_Type (Value_Net); @@ -536,6 +538,11 @@ package body Synth.Values is Value_Type_Net'(Kind => Value_Net, N => N, Typ => Ntype))); end Create_Value_Net; + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp is + begin + return (Ntype, Create_Value_Net (N, Ntype)); + end Create_Value_Net; + function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Value_Acc is @@ -548,6 +555,12 @@ package body Synth.Values is Typ => Vtype))); end Create_Value_Discrete; + function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) + return Valtyp is + begin + return (Vtype, Create_Value_Discrete (Val, Vtype)); + end Create_Value_Discrete; + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Value_Acc is subtype Value_Type_Float is Value_Type (Value_Float); @@ -560,6 +573,11 @@ package body Synth.Values is Fp => Val))); end Create_Value_Float; + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp is + begin + return (Vtype, Create_Value_Float (Val, Vtype)); + end Create_Value_Float; + function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) return Value_Acc is @@ -573,6 +591,12 @@ package body Synth.Values is Acc => Acc))); end Create_Value_Access; + function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) + return Valtyp is + begin + return (Vtype, Create_Value_Access (Vtype, Acc)); + end Create_Value_Access; + function Create_Value_File (Vtype : Type_Acc; File : File_Index) return Value_Acc is @@ -628,8 +652,14 @@ package body Synth.Values is return Res; end Create_Value_Array; + function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) + return Valtyp is + begin + return (Bounds, Create_Value_Array (Bounds, Arr)); + end Create_Value_Array; + function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) - return Value_Acc + return Value_Acc is subtype Value_Type_Const_Array is Value_Type (Value_Const_Array); function Alloc is @@ -644,6 +674,12 @@ package body Synth.Values is return Res; end Create_Value_Const_Array; + function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) + return Valtyp is + begin + return (Bounds, Create_Value_Const_Array (Bounds, Arr)); + end Create_Value_Const_Array; + function Get_Array_Flat_Length (Typ : Type_Acc) return Width is begin case Typ.Kind is @@ -701,6 +737,12 @@ package body Synth.Values is Rec => Els))); end Create_Value_Record; + function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) + return Valtyp is + begin + return (Typ, Create_Value_Record (Typ, Els)); + end Create_Value_Record; + function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) return Value_Acc is @@ -714,24 +756,11 @@ package body Synth.Values is Rec => Els))); end Create_Value_Const_Record; - function Create_Value_Instance (Inst : Instance_Id) return Value_Acc - is - subtype Value_Type_Instance is Value_Type (Value_Instance); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Instance); - begin - return To_Value_Acc - (Alloc (Current_Pool, - (Kind => Value_Instance, Instance => Inst, Typ => null))); - end Create_Value_Instance; - - function Create_Value_Subtype (Typ : Type_Acc) return Value_Acc - is - subtype Value_Type_Subtype is Value_Type (Value_Subtype); - function Alloc is new Areapools.Alloc_On_Pool_Addr (Value_Type_Subtype); + function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) + return Valtyp is begin - return To_Value_Acc (Alloc (Current_Pool, - (Kind => Value_Subtype, Typ => Typ))); - end Create_Value_Subtype; + return (Typ, Create_Value_Const_Record (Typ, Els)); + end Create_Value_Const_Record; function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) return Value_Acc @@ -746,6 +775,12 @@ package body Synth.Values is Typ => Typ))); end Create_Value_Alias; + function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) + return Valtyp is + begin + return (Typ, Create_Value_Alias (Obj, Off, Typ)); + end Create_Value_Alias; + function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) return Value_Acc is @@ -761,6 +796,12 @@ package body Synth.Values is Typ => Val.Typ))); end Create_Value_Const; + function Create_Value_Const (Val : Valtyp; Loc : Syn_Src) + return Valtyp is + begin + return (Val.Typ, Create_Value_Const (Val.Val, Loc)); + end Create_Value_Const; + procedure Strip_Const (Val : in out Value_Acc) is begin if Val.Kind = Value_Const then @@ -777,6 +818,11 @@ package body Synth.Values is end if; end Strip_Const; + procedure Strip_Const (Vt : in out Valtyp) is + begin + Vt.Val := Strip_Const (Vt.Val); + end Strip_Const; + function Copy (Src : Value_Acc) return Value_Acc; function Copy_Array (Arr : Value_Array_Acc) return Value_Array_Acc @@ -804,8 +850,6 @@ package body Synth.Values is Res := Create_Value_Discrete (Src.Scal, Src.Typ); when Value_Float => Res := Create_Value_Float (Src.Fp, Src.Typ); - when Value_Subtype => - Res := Create_Value_Subtype (Src.Typ); when Value_Array => Arr := Copy_Array (Src.Arr); Res := Create_Value_Array (Src.Typ, Arr); @@ -822,8 +866,6 @@ package body Synth.Values is Res := Create_Value_Access (Src.Typ, Src.Acc); when Value_File => Res := Create_Value_File (Src.Typ, Src.File); - when Value_Instance => - raise Internal_Error; when Value_Const => raise Internal_Error; when Value_Alias => @@ -959,6 +1001,11 @@ package body Synth.Values is end case; end Create_Value_Default; + function Create_Value_Default (Typ : Type_Acc) return Valtyp is + begin + return (Typ, Create_Value_Default (Typ)); + end Create_Value_Default; + function Value_To_String (Val : Value_Acc) return String is Str : String (1 .. Natural (Val.Arr.Len)); diff --git a/src/synth/synth-values.ads b/src/synth/synth-values.ads index c7eef52c4..d257664df 100644 --- a/src/synth/synth-values.ads +++ b/src/synth/synth-values.ads @@ -169,19 +169,13 @@ package Synth.Values is Value_Access, Value_File, - -- A package. - Value_Instance, - -- A constant. This is a named value. One purpose is to avoid to -- create many times the same net for the same value. Value_Const, -- An alias. This is a reference to another value with a different -- (but compatible) type. - Value_Alias, - - -- A subtype. Contains only a type. - Value_Subtype + Value_Alias ); type Value_Type (Kind : Value_Kind); @@ -197,8 +191,6 @@ package Synth.Values is type Value_Array_Acc is access Value_Array_Type; - type Instance_Id is new Nat32; - type Heap_Index is new Uns32; Null_Heap_Index : constant Heap_Index := 0; @@ -225,10 +217,6 @@ package Synth.Values is Acc : Heap_Index; when Value_File => File : File_Index; - when Value_Instance => - Instance : Instance_Id; - when Value_Subtype => - null; when Value_Const => C_Val : Value_Acc; C_Loc : Syn_Src; @@ -239,6 +227,14 @@ package Synth.Values is end case; end record; + -- A tuple of type and value. + type Valtyp is record + Typ : Type_Acc; + Val : Value_Acc; + end record; + + No_Valtyp : constant Valtyp := (null, null); + Global_Pool : aliased Areapool; Expr_Pool : aliased Areapool; @@ -293,30 +289,39 @@ package Synth.Values is -- Create a Value_Net. function Create_Value_Net (N : Net; Ntype : Type_Acc) return Value_Acc; + function Create_Value_Net (N : Net; Ntype : Type_Acc) return Valtyp; -- Create a Value_Wire. For a bit wire, RNG must be null. function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Value_Acc; + function Create_Value_Wire (W : Wire_Id; Wtype : Type_Acc) return Valtyp; function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) return Value_Acc; + function Create_Value_Discrete (Val : Int64; Vtype : Type_Acc) + return Valtyp; function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Value_Acc; + function Create_Value_Float (Val : Fp64; Vtype : Type_Acc) return Valtyp; function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) return Value_Acc; + function Create_Value_Access (Vtype : Type_Acc; Acc : Heap_Index) + return Valtyp; function Create_Value_File (Vtype : Type_Acc; File : File_Index) return Value_Acc; - function Create_Value_Subtype (Typ : Type_Acc) return Value_Acc; - function Create_Value_Array (Len : Iir_Index32) return Value_Array_Acc; -- Create a Value_Array. function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Value_Acc; + function Create_Value_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) + return Valtyp; function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) return Value_Acc; + function Create_Value_Const_Array (Bounds : Type_Acc; Arr : Value_Array_Acc) + return Valtyp; -- Like the previous one but automatically build the array. function Create_Value_Array (Bounds : Type_Acc) return Value_Acc; @@ -326,24 +331,32 @@ package Synth.Values is function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) return Value_Acc; + function Create_Value_Record (Typ : Type_Acc; Els : Value_Array_Acc) + return Valtyp; function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) return Value_Acc; - - function Create_Value_Instance (Inst : Instance_Id) return Value_Acc; + function Create_Value_Const_Record (Typ : Type_Acc; Els : Value_Array_Acc) + return Valtyp; function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) return Value_Acc; + function Create_Value_Alias (Obj : Value_Acc; Off : Uns32; Typ : Type_Acc) + return Valtyp; function Create_Value_Const (Val : Value_Acc; Loc : Syn_Src) return Value_Acc; + function Create_Value_Const (Val : Valtyp; Loc : Syn_Src) + return Valtyp; -- If VAL is a const, replace it by its value. procedure Strip_Const (Val : in out Value_Acc); + procedure Strip_Const (Vt : in out Valtyp); function Strip_Const (Val : Value_Acc) return Value_Acc; -- If VAL is a const or an alias, replace it by its value. -- Used to extract the real data of a static value. Note that the type -- is not correct anymore. function Strip_Alias_Const (V : Value_Acc) return Value_Acc; + function Strip_Alias_Const (V : Valtyp) return Valtyp; function Unshare (Src : Value_Acc; Pool : Areapool_Acc) return Value_Acc; @@ -361,6 +374,7 @@ package Synth.Values is -- Create a default initial value for TYP. function Create_Value_Default (Typ : Type_Acc) return Value_Acc; + function Create_Value_Default (Typ : Type_Acc) return Valtyp; -- Convert a value to a string. The value must be a const_array of scalar, -- which represent characters. |