diff options
Diffstat (limited to 'src/synth/synth-vhdl_decls.adb')
| -rw-r--r-- | src/synth/synth-vhdl_decls.adb | 769 |
1 files changed, 178 insertions, 591 deletions
diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb index e2d130631..8b54c94bd 100644 --- a/src/synth/synth-vhdl_decls.adb +++ b/src/synth/synth-vhdl_decls.adb @@ -17,7 +17,6 @@ -- along with this program. If not, see <gnu.org/licenses>. with Types; use Types; -with Mutils; use Mutils; with Std_Names; with Netlists.Builders; use Netlists.Builders; @@ -28,45 +27,49 @@ with Netlists.Gates; with Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Std_Package; -with Vhdl.Ieee.Std_Logic_1164; + +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Types; use Elab.Vhdl_Types; +with Elab.Vhdl_Decls; use Elab.Vhdl_Decls; +with Elab.Vhdl_Files; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Vhdl_Stmts; with Synth.Source; use Synth.Source; with Synth.Errors; use Synth.Errors; -with Synth.Vhdl_Files; -with Synth.Values; use Synth.Values; +with Synth.Vhdl_Context; use Synth.Vhdl_Context; package body Synth.Vhdl_Decls is - procedure Create_Var_Wire - (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : Valtyp) + function Create_Var_Wire (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Kind : Wire_Kind; + Init : Valtyp) return Valtyp is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Vt : constant Valtyp := Get_Value (Syn_Inst, Decl); Value : Net; Ival : Net; W : Width; Name : Sname; + Wid : Wire_Id; begin - case Vt.Val.Kind is - when Value_Wire => - -- FIXME: get the width directly from the wire ? - W := Get_Type_Width (Vt.Typ); - Name := New_Sname_User (Get_Identifier (Decl), - Get_Sname (Syn_Inst)); - if Init /= No_Valtyp then - Ival := Get_Net (Ctxt, Init); - pragma Assert (Get_Width (Ival) = W); - Value := Build_Isignal (Ctxt, Name, Ival); - else - Value := Build_Signal (Ctxt, Name, W); - end if; - Set_Location (Value, Decl); - Set_Wire_Gate (Vt.Val.W, Value); - when others => - raise Internal_Error; - end case; + Wid := Alloc_Wire (Kind, (Decl, Init.Typ)); + + -- FIXME: get the width directly from the wire ? + W := Get_Type_Width (Init.Typ); + Name := New_Sname_User (Get_Identifier (Decl), + Get_Sname (Syn_Inst)); + if Init.Val /= null then + Ival := Get_Net (Ctxt, Init); + pragma Assert (Get_Width (Ival) = W); + Value := Build_Isignal (Ctxt, Name, Ival); + else + Value := Build_Signal (Ctxt, Name, W); + end if; + Set_Location (Value, Decl); + + Set_Wire_Gate (Wid, Value); + return Create_Value_Wire (Wid, Init.Typ); end Create_Var_Wire; function Type_To_Param_Type (Atype : Node) return Param_Type @@ -119,403 +122,6 @@ package body Synth.Vhdl_Decls is return Pv; end Memtyp_To_Pval; - procedure Synth_Subtype_Indication_If_Anonymous - (Syn_Inst : Synth_Instance_Acc; Atype : Node) is - begin - if Get_Type_Declarator (Atype) = Null_Node then - Synth_Subtype_Indication (Syn_Inst, Atype); - end if; - end Synth_Subtype_Indication_If_Anonymous; - - function Synth_Subtype_Indication_If_Anonymous - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is - begin - if Get_Type_Declarator (Atype) = Null_Node then - return Synth_Subtype_Indication (Syn_Inst, Atype); - else - return Get_Subtype_Object (Syn_Inst, Atype); - end if; - end Synth_Subtype_Indication_If_Anonymous; - - function Synth_Array_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - El_Type : constant Node := Get_Element_Subtype (Def); - Ndims : constant Natural := Get_Nbr_Dimensions (Def); - El_Typ : Type_Acc; - Typ : Type_Acc; - begin - Synth_Subtype_Indication_If_Anonymous (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); - else - Typ := Create_Unbounded_Array (Dim_Type (Ndims), El_Typ); - end if; - return Typ; - end Synth_Array_Type_Definition; - - function Synth_Record_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - El_List : constant Node_Flist := Get_Elements_Declaration_List (Def); - Rec_Els : Rec_El_Array_Acc; - El : Node; - El_Type : Node; - El_Typ : Type_Acc; - begin - Rec_Els := Create_Rec_El_Array - (Iir_Index32 (Get_Nbr_Elements (El_List))); - - for I in Flist_First .. Flist_Last (El_List) loop - El := Get_Nth_Element (El_List, I); - El_Type := Get_Type (El); - El_Typ := Synth_Subtype_Indication_If_Anonymous (Syn_Inst, El_Type); - Rec_Els.E (Iir_Index32 (I + 1)).Typ := El_Typ; - end loop; - - if not Is_Fully_Constrained_Type (Def) then - return Create_Unbounded_Record (Rec_Els); - else - return Create_Record_Type (Rec_Els); - end if; - end Synth_Record_Type_Definition; - - function Synth_Access_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - Des_Type : constant Node := Get_Designated_Type (Def); - Des_Typ : Type_Acc; - Typ : Type_Acc; - begin - Synth_Subtype_Indication_If_Anonymous (Syn_Inst, Des_Type); - Des_Typ := Get_Subtype_Object (Syn_Inst, Des_Type); - - Typ := Create_Access_Type (Des_Typ); - return Typ; - end Synth_Access_Type_Definition; - - function Synth_File_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node) return Type_Acc - is - File_Type : constant Node := Get_Type (Get_File_Type_Mark (Def)); - File_Typ : Type_Acc; - Typ : Type_Acc; - Sig : String_Acc; - begin - File_Typ := Get_Subtype_Object (Syn_Inst, File_Type); - - if Get_Text_File_Flag (Def) - or else - Get_Kind (File_Type) in Iir_Kinds_Scalar_Type_And_Subtype_Definition - then - Sig := null; - else - declare - Sig_Str : String (1 .. Get_File_Signature_Length (File_Type) + 2); - Off : Natural := Sig_Str'First; - begin - Get_File_Signature (File_Type, Sig_Str, Off); - Sig_Str (Off + 0) := '.'; - Sig_Str (Off + 1) := ASCII.NUL; - Sig := new String'(Sig_Str); - end; - end if; - - Typ := Create_File_Type (File_Typ); - Typ.File_Signature := Sig; - - return Typ; - end Synth_File_Type_Definition; - - function Scalar_Size_To_Size (Def : Node) return Size_Type is - begin - case Get_Scalar_Size (Def) is - when Scalar_8 => - return 1; - when Scalar_16 => - return 2; - when Scalar_32 => - return 4; - when Scalar_64 => - return 8; - end case; - end Scalar_Size_To_Size; - - procedure Synth_Type_Definition (Syn_Inst : Synth_Instance_Acc; Def : Node) - is - Typ : Type_Acc; - begin - case Get_Kind (Def) is - when Iir_Kind_Enumeration_Type_Definition => - if Def = Vhdl.Ieee.Std_Logic_1164.Std_Ulogic_Type - or else Def = Vhdl.Ieee.Std_Logic_1164.Std_Logic_Type - then - Typ := Logic_Type; - elsif Def = Vhdl.Std_Package.Boolean_Type_Definition then - Typ := Boolean_Type; - elsif Def = Vhdl.Std_Package.Bit_Type_Definition then - Typ := Bit_Type; - else - declare - Nbr_El : constant Natural := - Get_Nbr_Elements (Get_Enumeration_Literal_List (Def)); - Rng : Discrete_Range_Type; - W : Width; - begin - W := Uns32 (Clog2 (Uns64 (Nbr_El))); - Rng := (Dir => Dir_To, - Is_Signed => False, - Left => 0, - Right => Int64 (Nbr_El - 1)); - Typ := Create_Discrete_Type - (Rng, Scalar_Size_To_Size (Def), W); - end; - end if; - when Iir_Kind_Array_Type_Definition => - Typ := Synth_Array_Type_Definition (Syn_Inst, Def); - when Iir_Kind_Access_Type_Definition => - Typ := Synth_Access_Type_Definition (Syn_Inst, Def); - when Iir_Kind_File_Type_Definition => - Typ := Synth_File_Type_Definition (Syn_Inst, Def); - when Iir_Kind_Record_Type_Definition => - Typ := Synth_Record_Type_Definition (Syn_Inst, Def); - when Iir_Kind_Protected_Type_Declaration => - Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Def)); - when others => - Vhdl.Errors.Error_Kind ("synth_type_definition", Def); - end case; - if Typ /= null then - Create_Subtype_Object (Syn_Inst, Def, Typ); - end if; - end Synth_Type_Definition; - - procedure Synth_Anonymous_Type_Definition - (Syn_Inst : Synth_Instance_Acc; Def : Node; St : Node) - is - Typ : Type_Acc; - begin - case Get_Kind (Def) is - when Iir_Kind_Integer_Type_Definition - | Iir_Kind_Physical_Type_Definition => - declare - Cst : constant Node := Get_Range_Constraint (St); - L, R : Int64; - Rng : Discrete_Range_Type; - W : Width; - begin - L := Get_Value (Get_Left_Limit (Cst)); - R := Get_Value (Get_Right_Limit (Cst)); - Rng := Build_Discrete_Range_Type (L, R, Get_Direction (Cst)); - W := Discrete_Range_Width (Rng); - Typ := Create_Discrete_Type - (Rng, Scalar_Size_To_Size (Def), W); - end; - when Iir_Kind_Floating_Type_Definition => - declare - Cst : constant Node := Get_Range_Constraint (St); - L, R : Fp64; - Rng : Float_Range_Type; - begin - L := Get_Fp_Value (Get_Left_Limit (Cst)); - R := Get_Fp_Value (Get_Right_Limit (Cst)); - Rng := (Get_Direction (Cst), L, R); - Typ := Create_Float_Type (Rng); - end; - when Iir_Kind_Array_Type_Definition => - Typ := Synth_Array_Type_Definition (Syn_Inst, Def); - when others => - Vhdl.Errors.Error_Kind ("synth_anonymous_type_definition", Def); - end case; - Create_Subtype_Object (Syn_Inst, Def, Typ); - end Synth_Anonymous_Type_Definition; - - function Synth_Discrete_Range_Constraint - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Discrete_Range_Type - is - Res : Discrete_Range_Type; - begin - Synth_Discrete_Range (Syn_Inst, Rng, Res); - return Res; - end Synth_Discrete_Range_Constraint; - - function Synth_Float_Range_Constraint - (Syn_Inst : Synth_Instance_Acc; Rng : Node) return Float_Range_Type is - begin - case Get_Kind (Rng) is - when Iir_Kind_Range_Expression => - -- FIXME: check range. - return Synth_Float_Range_Expression (Syn_Inst, Rng); - when others => - Vhdl.Errors.Error_Kind ("synth_float_range_constraint", Rng); - end case; - end Synth_Float_Range_Constraint; - - function Has_Element_Subtype_Indication (Atype : Node) return Boolean is - begin - return Get_Array_Element_Constraint (Atype) /= Null_Node - or else - (Get_Resolution_Indication (Atype) /= Null_Node - and then - (Get_Kind (Get_Resolution_Indication (Atype)) - = Iir_Kind_Array_Element_Resolution)); - end Has_Element_Subtype_Indication; - - function Synth_Array_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc - is - El_Type : constant Node := Get_Element_Subtype (Atype); - St_Indexes : constant Node_Flist := Get_Index_Subtype_List (Atype); - Ptype : Node; - St_El : Node; - Btyp : Type_Acc; - Etyp : Type_Acc; - Bnds : Bound_Array_Acc; - begin - -- VHDL08 - if Has_Element_Subtype_Indication (Atype) then - -- This subtype has created a new anonymous subtype for the - -- element. - Synth_Subtype_Indication (Syn_Inst, El_Type); - end if; - - if not Get_Index_Constraint_Flag (Atype) then - Ptype := Get_Type (Get_Subtype_Type_Mark (Atype)); - if Get_Element_Subtype (Ptype) = Get_Element_Subtype (Atype) then - -- That's an alias. - -- FIXME: maybe a resolution function was added? - -- FIXME: also handle resolution added in element subtype. - return Get_Subtype_Object (Syn_Inst, Ptype); - end if; - end if; - - 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 - St_El := Get_Index_Type (St_Indexes, 0); - return Create_Vector_Type - (Synth_Bounds_From_Range (Syn_Inst, St_El), Btyp.Uvec_El); - else - -- An alias. - -- Handle vhdl08 definition of std_logic_vector from - -- std_ulogic_vector. - return Btyp; - end if; - when Type_Unbounded_Array => - -- FIXME: partially constrained arrays, subtype in indexes... - 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))); - for I in Flist_First .. Flist_Last (St_Indexes) loop - St_El := Get_Index_Type (St_Indexes, I); - Bnds.D (Dim_Type (I + 1)) := - Synth_Bounds_From_Range (Syn_Inst, St_El); - end loop; - return Create_Array_Type (Bnds, Etyp); - else - raise Internal_Error; - end if; - when others => - raise Internal_Error; - end case; - end Synth_Array_Subtype_Indication; - - function Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) return Type_Acc is - begin - -- TODO: handle aliases directly. - case Get_Kind (Atype) is - when Iir_Kind_Array_Subtype_Definition => - return Synth_Array_Subtype_Indication (Syn_Inst, Atype); - when Iir_Kind_Record_Subtype_Definition => - return Synth_Record_Type_Definition (Syn_Inst, Atype); - when Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - declare - Btype : constant Type_Acc := - Get_Subtype_Object (Syn_Inst, Get_Base_Type (Atype)); - Rng : Discrete_Range_Type; - W : Width; - begin - if Btype.Kind in Type_Nets then - -- A subtype of a bit/logic type is still a bit/logic. - -- FIXME: bounds. - return Btype; - else - Rng := Synth_Discrete_Range_Constraint - (Syn_Inst, Get_Range_Constraint (Atype)); - W := Discrete_Range_Width (Rng); - return Create_Discrete_Type (Rng, Btype.Sz, W); - end if; - end; - when Iir_Kind_Floating_Subtype_Definition => - declare - Rng : Float_Range_Type; - begin - Rng := Synth_Float_Range_Constraint - (Syn_Inst, Get_Range_Constraint (Atype)); - return Create_Float_Type (Rng); - end; - when others => - Vhdl.Errors.Error_Kind ("synth_subtype_indication", Atype); - end case; - end Synth_Subtype_Indication; - - procedure Synth_Subtype_Indication - (Syn_Inst : Synth_Instance_Acc; Atype : Node) - is - Typ : Type_Acc; - begin - Typ := Synth_Subtype_Indication (Syn_Inst, Atype); - Create_Subtype_Object (Syn_Inst, Atype, Typ); - end Synth_Subtype_Indication; - - function Get_Declaration_Type (Decl : Node) return Node - is - Ind : constant Node := Get_Subtype_Indication (Decl); - Atype : Node; - begin - if Get_Is_Ref (Decl) or else Ind = Null_Iir then - -- A secondary declaration in a list. - return Null_Node; - end if; - Atype := Ind; - loop - case Get_Kind (Atype) is - when Iir_Kinds_Denoting_Name => - Atype := Get_Named_Entity (Atype); - when Iir_Kind_Subtype_Declaration - | Iir_Kind_Type_Declaration => - -- Type already declared, so already handled. - return Null_Node; - when Iir_Kind_Array_Subtype_Definition - | Iir_Kind_Record_Subtype_Definition - | Iir_Kind_Integer_Subtype_Definition - | Iir_Kind_Floating_Subtype_Definition - | Iir_Kind_Physical_Subtype_Definition - | Iir_Kind_Enumeration_Subtype_Definition => - return Atype; - when others => - Vhdl.Errors.Error_Kind ("get_declaration_type", Atype); - end case; - end loop; - end Get_Declaration_Type; - - procedure Synth_Declaration_Type - (Syn_Inst : Synth_Instance_Acc; Decl : Node) - is - Atype : constant Node := Get_Declaration_Type (Decl); - begin - if Atype = Null_Node then - return; - end if; - Synth_Subtype_Indication (Syn_Inst, Atype); - end Synth_Declaration_Type; - procedure Synth_Constant_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean; @@ -529,7 +135,7 @@ package body Synth.Vhdl_Decls is Cst : Valtyp; Obj_Type : Type_Acc; begin - Synth_Declaration_Type (Syn_Inst, Decl); + Elab_Declaration_Type (Syn_Inst, Decl); if Deferred_Decl = Null_Node or else Get_Deferred_Declaration_Flag (Decl) then @@ -616,7 +222,7 @@ package body Synth.Vhdl_Decls is | Iir_Kind_Interface_Signal_Declaration => V := Get_Value (Syn_Inst, Obj); pragma Assert (V.Val.Kind = Value_Wire); - Inst := Get_Net_Parent (Get_Wire_Gate (V.Val.W)); + Inst := Get_Net_Parent (Get_Wire_Gate (Get_Value_Wire (V.Val))); when Iir_Kind_Component_Instantiation_Statement => -- TODO return; @@ -667,59 +273,30 @@ package body Synth.Vhdl_Decls is Create_Object (Syn_Inst, Value, Val); -- Unshare (Val, Instance_Pool); - if not Get_Instance_Const (Syn_Inst) then - Synth_Attribute_Object (Syn_Inst, Value, Attr_Decl, Val); - end if; - Value := Get_Spec_Chain (Value); end loop; end Synth_Attribute_Specification; - procedure Synth_Subprogram_Declaration - (Syn_Inst : Synth_Instance_Acc; Subprg : Node) + procedure Synth_Concurrent_Attribute_Specification + (Syn_Inst : Synth_Instance_Acc; Spec : Node) is - Inter : Node; + Attr_Decl : constant Node := + Get_Named_Entity (Get_Attribute_Designator (Spec)); + Value : Node; + Val : Valtyp; begin - if Is_Second_Subprogram_Specification (Subprg) then - -- Already handled. + if Get_Instance_Const (Syn_Inst) then return; end if; - Inter := Get_Interface_Declaration_Chain (Subprg); - while Inter /= Null_Node loop - Synth_Declaration_Type (Syn_Inst, Inter); - Inter := Get_Chain (Inter); - end loop; - end Synth_Subprogram_Declaration; - - procedure Synth_Convertible_Declarations (Syn_Inst : Synth_Instance_Acc) - is - use Vhdl.Std_Package; - begin - Create_Subtype_Object - (Syn_Inst, Convertible_Integer_Type_Definition, - Get_Subtype_Object (Syn_Inst, Universal_Integer_Type_Definition)); - Create_Subtype_Object - (Syn_Inst, Convertible_Real_Type_Definition, - Get_Subtype_Object (Syn_Inst, Universal_Real_Type_Definition)); - end Synth_Convertible_Declarations; + Value := Get_Attribute_Value_Spec_Chain (Spec); + while Value /= Null_Iir loop + Val := Get_Value (Syn_Inst, Value); + Synth_Attribute_Object (Syn_Inst, Value, Attr_Decl, Val); - function Create_Package_Instance (Parent_Inst : Synth_Instance_Acc; - Pkg : Node) - return Synth_Instance_Acc - is - Syn_Inst : Synth_Instance_Acc; - begin - Syn_Inst := Make_Instance (Parent_Inst, Pkg); - if Get_Kind (Get_Parent (Pkg)) = Iir_Kind_Design_Unit then - -- Global package. - Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, True); - else - -- Local package: check elaboration order. - Create_Package_Object (Parent_Inst, Pkg, Syn_Inst, False); - end if; - return Syn_Inst; - end Create_Package_Instance; + Value := Get_Spec_Chain (Value); + end loop; + end Synth_Concurrent_Attribute_Specification; procedure Synth_Package_Declaration (Parent_Inst : Synth_Instance_Acc; Pkg : Node) @@ -731,12 +308,10 @@ package body Synth.Vhdl_Decls is return; end if; - Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg); + Syn_Inst := Get_Package_Object (Parent_Inst, Pkg); + Set_Extra (Syn_Inst, Parent_Inst, No_Sname); - Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); - if Pkg = Vhdl.Std_Package.Standard_Package then - Synth_Convertible_Declarations (Syn_Inst); - end if; + Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); end Synth_Package_Declaration; procedure Synth_Package_Body @@ -751,97 +326,18 @@ package body Synth.Vhdl_Decls is Pkg_Inst := Get_Package_Object (Parent_Inst, Pkg); - Synth_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod)); + Synth_Concurrent_Declarations (Pkg_Inst, Get_Declaration_Chain (Bod)); end Synth_Package_Body; - procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc; - Syn_Inst : Synth_Instance_Acc; - Inter_Chain : Node; - Assoc_Chain : Node) - is - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Inter : Node; - Inter_Type : Type_Acc; - Assoc : Node; - Assoc_Inter : Node; - Actual : Node; - Val : Valtyp; - begin - Assoc := Assoc_Chain; - Assoc_Inter := Inter_Chain; - while Is_Valid (Assoc) loop - Inter := Get_Association_Interface (Assoc, Assoc_Inter); - case Iir_Kinds_Interface_Declaration (Get_Kind (Inter)) is - when Iir_Kind_Interface_Constant_Declaration => - Synth_Declaration_Type (Sub_Inst, Inter); - Inter_Type := Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); - - case Get_Kind (Assoc) is - when Iir_Kind_Association_Element_Open => - Actual := Get_Default_Value (Inter); - Val := Synth_Expression_With_Type - (Sub_Inst, Actual, Inter_Type); - when Iir_Kind_Association_Element_By_Expression => - Actual := Get_Actual (Assoc); - Val := Synth_Expression_With_Type - (Syn_Inst, Actual, Inter_Type); - when others => - raise Internal_Error; - end case; - - Val := Synth_Subtype_Conversion - (Ctxt, Val, Inter_Type, True, Assoc); - - if Val = No_Valtyp then - Set_Error (Sub_Inst); - elsif not Is_Static (Val.Val) then - Error_Msg_Synth - (+Assoc, "value of generic %i must be static", +Inter); - Val := No_Valtyp; - Set_Error (Sub_Inst); - end if; - - Create_Object (Sub_Inst, Inter, Val); - - when Iir_Kind_Interface_Package_Declaration => - declare - Actual : constant Iir := - Strip_Denoting_Name (Get_Actual (Assoc)); - Pkg_Inst : Synth_Instance_Acc; - begin - Pkg_Inst := Get_Package_Object (Sub_Inst, Actual); - Create_Package_Interface (Sub_Inst, Inter, Pkg_Inst); - end; - - when Iir_Kind_Interface_Variable_Declaration - | Iir_Kind_Interface_File_Declaration - | Iir_Kind_Interface_Signal_Declaration - | Iir_Kind_Interface_Quantity_Declaration - | Iir_Kind_Interface_Terminal_Declaration => - raise Internal_Error; - - when Iir_Kinds_Interface_Subprogram_Declaration - | Iir_Kind_Interface_Type_Declaration => - raise Internal_Error; - end case; - - Next_Association_Interface (Assoc, Assoc_Inter); - end loop; - end Synth_Generics_Association; - procedure Synth_Package_Instantiation (Parent_Inst : Synth_Instance_Acc; Pkg : Node) is Bod : constant Node := Get_Instance_Package_Body (Pkg); Sub_Inst : Synth_Instance_Acc; begin - Sub_Inst := Create_Package_Instance (Parent_Inst, Pkg); - - Synth_Generics_Association - (Sub_Inst, Parent_Inst, - Get_Generic_Chain (Pkg), Get_Generic_Map_Aspect_Chain (Pkg)); + Sub_Inst := Get_Package_Object (Parent_Inst, Pkg); - Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg)); + Synth_Concurrent_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg)); if Bod /= Null_Node then -- Macro expanded package instantiation. @@ -855,7 +351,7 @@ package body Synth.Vhdl_Decls is Set_Uninstantiated_Scope (Sub_Inst, Uninst); -- Synth declarations of (optional) body. if Uninst_Bod /= Null_Node then - Synth_Declarations + Synth_Concurrent_Declarations (Sub_Inst, Get_Declaration_Chain (Uninst_Bod)); end if; end; @@ -870,10 +366,11 @@ package body Synth.Vhdl_Decls is Def : constant Node := Get_Default_Value (Decl); Decl_Type : constant Node := Get_Type (Decl); Init : Valtyp; + Val : Valtyp; Obj_Typ : Type_Acc; Wid : Wire_Id; begin - Synth_Declaration_Type (Syn_Inst, Decl); + Elab_Declaration_Type (Syn_Inst, Decl); if Get_Kind (Decl_Type) = Iir_Kind_Protected_Type_Declaration then Error_Msg_Synth (+Decl, "protected type variable is not synthesizable"); @@ -910,9 +407,9 @@ package body Synth.Vhdl_Decls is Init := Unshare (Init, Current_Pool); Create_Object (Syn_Inst, Decl, Init); else - Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); - Create_Var_Wire (Syn_Inst, Decl, Init); - Wid := Get_Value (Syn_Inst, Decl).Val.W; + Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init); + Create_Object (Syn_Inst, Decl, Val); + Wid := Get_Value_Wire (Val.Val); if Is_Subprg then if Is_Static (Init.Val) then Phi_Assign_Static (Wid, Get_Memtyp (Init)); @@ -924,36 +421,39 @@ package body Synth.Vhdl_Decls is end if; end Synth_Variable_Declaration; + procedure Synth_Shared_Variable_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node) + is + Init : Valtyp; + Val : Valtyp; + begin + Init := Get_Value (Syn_Inst, Decl); + + Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Variable, Init); + Mutate_Object (Syn_Inst, Decl, Val); + end Synth_Shared_Variable_Declaration; + procedure Synth_Signal_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node) is - Ctxt : constant Context_Acc := Get_Build (Syn_Inst); - Def : constant Iir := Get_Default_Value (Decl); - -- Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + Prev : Valtyp; Init : Valtyp; - Obj_Typ : Type_Acc; + Val : Valtyp; begin - Synth_Declaration_Type (Syn_Inst, Decl); if Get_Kind (Get_Parent (Decl)) = Iir_Kind_Package_Declaration then Error_Msg_Synth (+Decl, "signals in packages are not supported"); - -- Avoid elaboration error. - Create_Object (Syn_Inst, Decl, No_Valtyp); return; end if; - Create_Wire_Object (Syn_Inst, Wire_Signal, Decl); - if Is_Valid (Def) then - Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); - Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); - Init := Synth_Subtype_Conversion (Ctxt, Init, Obj_Typ, False, Decl); - if not Is_Static (Init.Val) then - Error_Msg_Synth (+Decl, "signals cannot be used in default value " - & "of a signal"); - end if; + Prev := Get_Value (Syn_Inst, Decl); + if Prev.Val.Init = null then + Init := (Prev.Typ, null); else - Init := No_Valtyp; + Init := (Prev.Typ, Prev.Val.Init); end if; - Create_Var_Wire (Syn_Inst, Decl, Init); + + Val := Create_Var_Wire (Syn_Inst, Decl, Wire_Signal, Init); + Replace_Signal (Syn_Inst, Decl, Val); end Synth_Signal_Declaration; procedure Synth_Object_Alias_Declaration @@ -983,7 +483,8 @@ package body Synth.Vhdl_Decls is -- Object is a net if it is not writable. Extract the -- bits for the alias. Res := Create_Value_Net - (Build2_Extract (Ctxt, Base.Val.N, Off.Net_Off, Typ.W), + (Build2_Extract (Ctxt, + Get_Value_Net (Base.Val), Off.Net_Off, Typ.W), Typ); else Res := Create_Value_Alias (Base, Off, Typ); @@ -994,6 +495,36 @@ package body Synth.Vhdl_Decls is Create_Object (Syn_Inst, Decl, Res); end Synth_Object_Alias_Declaration; + procedure Synth_Concurrent_Object_Alias_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Val : Valtyp; + Aval : Valtyp; + Obj : Value_Acc; + Base : Node; + begin + Val := Get_Value (Syn_Inst, Decl); + pragma Assert (Val.Val.Kind = Value_Alias); + Obj := Val.Val.A_Obj; + if Obj.Kind = Value_Signal then + -- A signal must have been changed to a wire or a net, but the + -- aliases have not been updated. Update here. + Base := Get_Base_Name (Get_Name (Decl)); + Aval := Synth_Expression (Syn_Inst, Base); + + if Aval.Val.Kind = Value_Net then + -- Object is a net if it is not writable. Extract the + -- bits for the alias. + Aval := Create_Value_Net + (Build2_Extract (Get_Build (Syn_Inst), Get_Value_Net (Aval.Val), + Val.Val.A_Off.Net_Off, Val.Typ.W), + Val.Typ); + Val.Val.A_Off := (0, 0); + end if; + Val.Val.A_Obj := Aval.Val; + end if; + end Synth_Concurrent_Object_Alias_Declaration; + procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean; @@ -1004,8 +535,15 @@ package body Synth.Vhdl_Decls is Synth_Variable_Declaration (Syn_Inst, Decl, Is_Subprg); when Iir_Kind_Interface_Variable_Declaration => -- Ignore default value. - Create_Wire_Object (Syn_Inst, Wire_Variable, Decl); - Create_Var_Wire (Syn_Inst, Decl, No_Valtyp); + declare + Val : Valtyp; + Obj_Typ : Type_Acc; + begin + Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); + Val := Create_Var_Wire + (Syn_Inst, Decl, Wire_Variable, (Obj_Typ, null)); + Create_Object (Syn_Inst, Decl, Val); + end; when Iir_Kind_Constant_Declaration => Synth_Constant_Declaration (Syn_Inst, Decl, Is_Subprg, Last_Type); when Iir_Kind_Signal_Declaration => @@ -1015,7 +553,7 @@ package body Synth.Vhdl_Decls is Synth_Object_Alias_Declaration (Syn_Inst, Decl); when Iir_Kind_Procedure_Declaration | Iir_Kind_Function_Declaration => - Synth_Subprogram_Declaration (Syn_Inst, Decl); + Elab_Subprogram_Declaration (Syn_Inst, Decl); when Iir_Kind_Procedure_Body | Iir_Kind_Function_Body => null; @@ -1028,13 +566,13 @@ package body Synth.Vhdl_Decls is when Iir_Kind_Attribute_Specification => Synth_Attribute_Specification (Syn_Inst, Decl); when Iir_Kind_Type_Declaration => - Synth_Type_Definition (Syn_Inst, Get_Type_Definition (Decl)); + Elab_Type_Definition (Syn_Inst, Get_Type_Definition (Decl)); when Iir_Kind_Anonymous_Type_Declaration => - Synth_Anonymous_Type_Definition + Elab_Anonymous_Type_Definition (Syn_Inst, Get_Type_Definition (Decl), Get_Subtype_Definition (Decl)); when Iir_Kind_Subtype_Declaration => - Synth_Declaration_Type (Syn_Inst, Decl); + Elab_Declaration_Type (Syn_Inst, Decl); when Iir_Kind_Component_Declaration => null; when Iir_Kind_File_Declaration => @@ -1043,7 +581,7 @@ package body Synth.Vhdl_Decls is Res : Valtyp; Obj_Typ : Type_Acc; begin - F := Synth.Vhdl_Files.Elaborate_File_Declaration + F := Elab.Vhdl_Files.Elaborate_File_Declaration (Syn_Inst, Decl); Obj_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Decl)); Res := Create_Value_File (Obj_Typ, F); @@ -1067,7 +605,7 @@ package body Synth.Vhdl_Decls is end Synth_Declaration; procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc; - Decls : Iir; + Decls : Node; Is_Subprg : Boolean := False) is Decl : Node; @@ -1093,6 +631,7 @@ package body Synth.Vhdl_Decls is Gate : Instance; Drv : Net; Def_Val : Net; + W : Wire_Id; begin Vt := Get_Value (Syn_Inst, Decl); if Vt = No_Valtyp then @@ -1105,9 +644,11 @@ package body Synth.Vhdl_Decls is return; end if; - Finalize_Assignment (Get_Build (Syn_Inst), Vt.Val.W); + W := Get_Value_Wire (Vt.Val); + + Finalize_Assignment (Get_Build (Syn_Inst), W); - Gate_Net := Get_Wire_Gate (Vt.Val.W); + Gate_Net := Get_Wire_Gate (W); Gate := Get_Net_Parent (Gate_Net); case Get_Id (Gate) is when Id_Signal @@ -1147,7 +688,7 @@ package body Synth.Vhdl_Decls is Connect (Get_Input (Gate, 0), Def_Val); end if; - Free_Wire (Vt.Val.W); + Free_Wire (W); end Finalize_Signal; procedure Finalize_Declaration @@ -1203,10 +744,10 @@ package body Synth.Vhdl_Decls is end Finalize_Declaration; procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc; - Decls : Iir; + Decls : Node; Is_Subprg : Boolean := False) is - Decl : Iir; + Decl : Node; begin Decl := Decls; while Is_Valid (Decl) loop @@ -1215,4 +756,50 @@ package body Synth.Vhdl_Decls is Decl := Get_Chain (Decl); end loop; end Finalize_Declarations; + + procedure Synth_Concurrent_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Signal_Declaration => + Synth_Signal_Declaration (Syn_Inst, Decl); + when Iir_Kind_Variable_Declaration => + Synth_Shared_Variable_Declaration (Syn_Inst, Decl); + when Iir_Kind_Constant_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Procedure_Body + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Component_Declaration + | Iir_Kind_File_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Configuration_Specification + | Iir_Kind_Psl_Default_Clock + | Iir_Kind_Non_Object_Alias_Declaration + | Iir_Kind_Use_Clause => + -- Fully handled during elaboration. + null; + when Iir_Kind_Object_Alias_Declaration => + Synth_Concurrent_Object_Alias_Declaration (Syn_Inst, Decl); + when Iir_Kind_Attribute_Specification => + Synth_Concurrent_Attribute_Specification (Syn_Inst, Decl); + when others => + Vhdl.Errors.Error_Kind ("synth_concurrent_declaration", Decl); + end case; + end Synth_Concurrent_Declaration; + + procedure Synth_Concurrent_Declarations (Syn_Inst : Synth_Instance_Acc; + Decls : Node) + is + Decl : Node; + begin + Decl := Decls; + while Decl /= Null_Node loop + Synth_Concurrent_Declaration (Syn_Inst, Decl); + Decl := Get_Chain (Decl); + end loop; + end Synth_Concurrent_Declarations; end Synth.Vhdl_Decls; |