diff options
Diffstat (limited to 'src/synth/synth-vhdl_decls.adb')
| -rw-r--r-- | src/synth/synth-vhdl_decls.adb | 1227 |
1 files changed, 1227 insertions, 0 deletions
diff --git a/src/synth/synth-vhdl_decls.adb b/src/synth/synth-vhdl_decls.adb new file mode 100644 index 000000000..7507d21b0 --- /dev/null +++ b/src/synth/synth-vhdl_decls.adb @@ -0,0 +1,1227 @@ +-- Create declarations for synthesis. +-- Copyright (C) 2017 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with Types; use Types; +with Mutils; use Mutils; +with Std_Names; + +with Netlists.Builders; use Netlists.Builders; +with Netlists.Folds; use Netlists.Folds; +with Netlists.Utils; use Netlists.Utils; +with Netlists.Gates; + +with Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Std_Package; +with Vhdl.Ieee.Std_Logic_1164; + +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; + +package body Synth.Vhdl_Decls is + procedure Create_Var_Wire + (Syn_Inst : Synth_Instance_Acc; Decl : Iir; Init : 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; + 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; + end Create_Var_Wire; + + function Type_To_Param_Type (Atype : Node) return Param_Type + is + use Vhdl.Std_Package; + Btype : constant Node := Get_Base_Type (Atype); + begin + if Btype = String_Type_Definition then + return Param_Pval_String; + elsif Btype = Time_Type_Definition then + return Param_Pval_Time_Ps; + else + case Get_Kind (Btype) is + when Iir_Kind_Integer_Type_Definition => + return Param_Pval_Integer; + when Iir_Kind_Floating_Type_Definition => + return Param_Pval_Real; + when others => + return Param_Pval_Vector; + end case; + end if; + end Type_To_Param_Type; + + function Memtyp_To_Pval (Mt : Memtyp) return Pval + is + Len : constant Uns32 := (Mt.Typ.W + 31) / 32; + Vec : Logvec_Array_Acc; + Off : Uns32; + Has_Zx : Boolean; + Pv : Pval; + begin + if Len = 0 then + return Create_Pval2 (0); + end if; + + Vec := new Logvec_Array'(0 .. Digit_Index (Len - 1) => (0, 0)); + Off := 0; + Has_Zx := False; + Value2logvec (Mt, 0, Mt.Typ.W, Vec.all, Off, Has_Zx); + pragma Assert (Off = Mt.Typ.W); + if Has_Zx then + Pv := Create_Pval4 (Mt.Typ.W); + else + Pv := Create_Pval2 (Mt.Typ.W); + end if; + for I in 0 .. Len - 1 loop + Write_Pval (Pv, I, Vec (Digit_Index (I))); + end loop; + Free_Logvec_Array (Vec); + 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; + Last_Type : in out Node) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Deferred_Decl : constant Node := Get_Deferred_Declaration (Decl); + First_Decl : Node; + Decl_Type : Node; + Val : Valtyp; + Cst : Valtyp; + Obj_Type : Type_Acc; + begin + Synth_Declaration_Type (Syn_Inst, Decl); + if Deferred_Decl = Null_Node + or else Get_Deferred_Declaration_Flag (Decl) + then + -- Create the object (except for full declaration of a + -- deferred constant). + Create_Object (Syn_Inst, Decl, No_Valtyp); + end if; + -- Initialize the value (except for a deferred declaration). + if Get_Deferred_Declaration_Flag (Decl) then + return; + end if; + if Deferred_Decl = Null_Node then + -- A normal constant declaration + First_Decl := Decl; + else + -- The full declaration of a deferred constant. + First_Decl := Deferred_Decl; + end if; + pragma Assert (First_Decl /= Null_Node); + + -- Use the type of the declaration. The type of the constant may + -- be derived from the value. + -- FIXME: what about multiple declarations ? + Decl_Type := Get_Subtype_Indication (Decl); + if Decl_Type = Null_Node then + Decl_Type := Last_Type; + else + if Get_Kind (Decl_Type) in Iir_Kinds_Denoting_Name then + -- Type mark. + Decl_Type := Get_Type (Get_Named_Entity (Decl_Type)); + end if; + Last_Type := Decl_Type; + end if; + Obj_Type := Get_Subtype_Object (Syn_Inst, Decl_Type); + Val := Synth_Expression_With_Type + (Syn_Inst, Get_Default_Value (Decl), Obj_Type); + if Val = No_Valtyp then + Set_Error (Syn_Inst); + return; + end if; + Val := Synth_Subtype_Conversion (Ctxt, 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.Val)); + case Val.Val.Kind is + when Value_Const + | Value_Alias => + Cst := Val; + when others => + if Is_Static (Val.Val) then + Cst := Create_Value_Const (Val, Decl); + else + if not Is_Subprg then + Error_Msg_Synth + (+Decl, "signals cannot be used in default value " + & "of this constant"); + end if; + Cst := Val; + end if; + end case; + Create_Object_Force (Syn_Inst, First_Decl, Cst); + end Synth_Constant_Declaration; + + procedure Synth_Attribute_Object (Syn_Inst : Synth_Instance_Acc; + Attr_Value : Node; + Attr_Decl : Node; + Val : Valtyp) + is + Obj : constant Node := Get_Designated_Entity (Attr_Value); + Id : constant Name_Id := Get_Identifier (Attr_Decl); + Inst : Instance; + V : Valtyp; + Ptype : Param_Type; + Pv : Pval; + begin + if Id = Std_Names.Name_Foreign then + -- Not for synthesis. + return; + end if; + + case Get_Kind (Obj) is + when Iir_Kind_Signal_Declaration + | Iir_Kind_Variable_Declaration + | 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)); + when Iir_Kind_Component_Instantiation_Statement => + -- TODO + return; + when others => + -- TODO: components ? + -- TODO: Interface_Signal ? But no instance for them. + Warning_Msg_Synth + (+Attr_Value, "attribute %i for %n is not kept in the netlist", + (+Attr_Decl, +Obj)); + return; + end case; + + Ptype := Type_To_Param_Type (Get_Type (Attr_Decl)); + Pv := Memtyp_To_Pval (Get_Memtyp (Val)); + + Set_Attribute (Inst, Id, Ptype, Pv); + end Synth_Attribute_Object; + + procedure Synth_Attribute_Specification + (Syn_Inst : Synth_Instance_Acc; Spec : Node) + is + Attr_Decl : constant Node := + Get_Named_Entity (Get_Attribute_Designator (Spec)); + Value : Node; + Val : Valtyp; + Val_Type : Type_Acc; + begin + Val_Type := Get_Subtype_Object (Syn_Inst, Get_Type (Attr_Decl)); + Value := Get_Attribute_Value_Spec_Chain (Spec); + while Value /= Null_Iir loop + -- 2. The expression is evaluated to determine the value + -- of the attribute. + -- It is an error if the value of the expression does not + -- belong to the subtype of the attribute; if the + -- attribute is of an array type, then an implicit + -- subtype conversion is first performed on the value, + -- unless the attribute's subtype indication denotes an + -- unconstrained array type. + Val := Synth_Expression_With_Type + (Syn_Inst, Get_Expression (Spec), Val_Type); + -- Check_Constraints (Instance, Val, Attr_Type, Decl); + + -- 3. A new instance of the designated attribute is created + -- and associated with each of the affected items. + -- + -- 4. Each new attribute instance is assigned the value of + -- the expression. + 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) + is + Inter : Node; + begin + if Is_Second_Subprogram_Specification (Subprg) then + -- Already handled. + 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; + + 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; + + procedure Synth_Package_Declaration + (Parent_Inst : Synth_Instance_Acc; Pkg : Node) + is + Syn_Inst : Synth_Instance_Acc; + begin + if Is_Uninstantiated_Package (Pkg) then + -- Nothing to do (yet) for uninstantiated packages. + return; + end if; + + Syn_Inst := Create_Package_Instance (Parent_Inst, Pkg); + + Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Pkg)); + if Pkg = Vhdl.Std_Package.Standard_Package then + Synth_Convertible_Declarations (Syn_Inst); + end if; + end Synth_Package_Declaration; + + procedure Synth_Package_Body + (Parent_Inst : Synth_Instance_Acc; Pkg : Node; Bod : Node) + is + Pkg_Inst : Synth_Instance_Acc; + begin + if Is_Uninstantiated_Package (Pkg) then + -- Nothing to do (yet) for uninstantiated packages. + return; + end if; + + Pkg_Inst := Get_Package_Object (Parent_Inst, Pkg); + + Synth_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)); + + Synth_Declarations (Sub_Inst, Get_Declaration_Chain (Pkg)); + + if Bod /= Null_Node then + -- Macro expanded package instantiation. + raise Internal_Error; + else + -- Shared body + declare + Uninst : constant Node := Get_Uninstantiated_Package_Decl (Pkg); + Uninst_Bod : constant Node := Get_Package_Body (Uninst); + begin + Set_Uninstantiated_Scope (Sub_Inst, Uninst); + -- Synth declarations of (optional) body. + if Uninst_Bod /= Null_Node then + Synth_Declarations + (Sub_Inst, Get_Declaration_Chain (Uninst_Bod)); + end if; + end; + end if; + end Synth_Package_Instantiation; + + procedure Synth_Variable_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Is_Subprg : Boolean) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Def : constant Node := Get_Default_Value (Decl); + Decl_Type : constant Node := Get_Type (Decl); + Init : Valtyp; + Obj_Typ : Type_Acc; + Wid : Wire_Id; + begin + Synth_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"); + Set_Error (Syn_Inst); + Create_Object (Syn_Inst, Decl, No_Valtyp); + return; + end if; + + Obj_Typ := Get_Subtype_Object (Syn_Inst, Decl_Type); + 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_Typ)); + else + if Is_Valid (Def) then + Init := Synth_Expression_With_Type (Syn_Inst, Def, Obj_Typ); + Init := Synth_Subtype_Conversion + (Ctxt, Init, Obj_Typ, False, Decl); + if not Is_Subprg + and then not Is_Static (Init.Val) + then + Error_Msg_Synth + (+Decl, "signals cannot be used in default value of " + & "this variable"); + end if; + else + Init := Create_Value_Default (Obj_Typ); + end if; + if Get_Instance_Const (Syn_Inst) then + Init := Strip_Alias_Const (Init); + 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; + if Is_Subprg then + if Is_Static (Init.Val) then + Phi_Assign_Static (Wid, Get_Memtyp (Init)); + else + Phi_Assign_Net (Ctxt, Wid, Get_Net (Ctxt, Init), 0); + end if; + end if; + end if; + end if; + end Synth_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; + Init : Valtyp; + Obj_Typ : Type_Acc; + 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; + else + Init := No_Valtyp; + end if; + Create_Var_Wire (Syn_Inst, Decl, Init); + end Synth_Signal_Declaration; + + procedure Synth_Object_Alias_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + Atype : constant Node := Get_Declaration_Type (Decl); + Off : Value_Offsets; + Dyn : Vhdl_Stmts.Dyn_Name; + Res : Valtyp; + Obj_Typ : Type_Acc; + Base : Valtyp; + Typ : Type_Acc; + begin + -- Subtype indication may not be present. + if Atype /= Null_Node then + Synth_Subtype_Indication (Syn_Inst, Atype); + Obj_Typ := Get_Subtype_Object (Syn_Inst, Atype); + else + Obj_Typ := null; + end if; + + Vhdl_Stmts.Synth_Assignment_Prefix (Syn_Inst, Get_Name (Decl), + Base, Typ, Off, Dyn); + pragma Assert (Dyn.Voff = No_Net); + if Base.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 (Ctxt, Base.Val.N, Off.Net_Off, Typ.W), + Typ); + else + Res := Create_Value_Alias (Base, Off, Typ); + end if; + if Obj_Typ /= null then + Res := Synth_Subtype_Conversion (Ctxt, Res, Obj_Typ, True, Decl); + end if; + Create_Object (Syn_Inst, Decl, Res); + end Synth_Object_Alias_Declaration; + + procedure Synth_Declaration (Syn_Inst : Synth_Instance_Acc; + Decl : Node; + Is_Subprg : Boolean; + Last_Type : in out Node) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Variable_Declaration => + 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); + when Iir_Kind_Constant_Declaration => + Synth_Constant_Declaration (Syn_Inst, Decl, Is_Subprg, Last_Type); + when Iir_Kind_Signal_Declaration => + pragma Assert (not Is_Subprg); + Synth_Signal_Declaration (Syn_Inst, Decl); + when Iir_Kind_Object_Alias_Declaration => + Synth_Object_Alias_Declaration (Syn_Inst, Decl); + when Iir_Kind_Anonymous_Signal_Declaration => + -- Anonymous signals created by inertial associations are + -- simply ignored. + null; + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + Synth_Subprogram_Declaration (Syn_Inst, Decl); + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + null; + when Iir_Kind_Non_Object_Alias_Declaration => + null; + when Iir_Kind_Attribute_Declaration => + -- Nothing to do: the type is a type_mark, not a subtype + -- indication. + null; + 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)); + when Iir_Kind_Anonymous_Type_Declaration => + Synth_Anonymous_Type_Definition + (Syn_Inst, Get_Type_Definition (Decl), + Get_Subtype_Definition (Decl)); + when Iir_Kind_Subtype_Declaration => + Synth_Declaration_Type (Syn_Inst, Decl); + when Iir_Kind_Component_Declaration => + null; + when Iir_Kind_File_Declaration => + declare + F : File_Index; + Res : Valtyp; + Obj_Typ : Type_Acc; + begin + F := Synth.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); + Create_Object (Syn_Inst, Decl, Res); + end; + when Iir_Kind_Protected_Type_Body => + null; + when Iir_Kind_Psl_Default_Clock => + -- Ignored; directly used by PSL directives. + null; + when Iir_Kind_Use_Clause => + null; + when Iir_Kind_Configuration_Specification => + null; + when Iir_Kind_Signal_Attribute_Declaration => + -- Not supported by synthesis. + null; + when others => + Vhdl.Errors.Error_Kind ("synth_declaration", Decl); + end case; + end Synth_Declaration; + + procedure Synth_Declarations (Syn_Inst : Synth_Instance_Acc; + Decls : Iir; + Is_Subprg : Boolean := False) + is + Decl : Node; + Last_Type : Node; + begin + Last_Type := Null_Node; + Decl := Decls; + while Is_Valid (Decl) loop + Synth_Declaration (Syn_Inst, Decl, Is_Subprg, Last_Type); + + exit when Is_Error (Syn_Inst); + + Decl := Get_Chain (Decl); + end loop; + end Synth_Declarations; + + procedure Finalize_Signal (Syn_Inst : Synth_Instance_Acc; Decl : Node) + is + use Netlists.Gates; + Vt : Valtyp; + Gate_Net : Net; + Gate : Instance; + Drv : Net; + Def_Val : Net; + begin + Vt := Get_Value (Syn_Inst, Decl); + if Vt = No_Valtyp then + pragma Assert (Is_Error (Syn_Inst)); + return; + end if; + if Vt.Val.Kind = Value_Net then + -- Could be a net for in ports. + return; + end if; + + Finalize_Assignment (Get_Build (Syn_Inst), Vt.Val.W); + + Gate_Net := Get_Wire_Gate (Vt.Val.W); + Gate := Get_Net_Parent (Gate_Net); + case Get_Id (Gate) is + when Id_Signal + | Id_Output + | Id_Inout => + Drv := Get_Input_Net (Gate, 0); + Def_Val := No_Net; + when Id_Isignal + | Id_Ioutput + | Id_Iinout => + Drv := Get_Input_Net (Gate, 0); + Def_Val := Get_Input_Net (Gate, 1); + when others => + -- Todo: output ? + raise Internal_Error; + end case; + if Drv = No_Net then + if Is_Connected (Get_Output (Gate, 0)) then + -- No warning if the signal is not used. + -- TODO: maybe simply remove it. + if Def_Val = No_Net then + Warning_Msg_Synth + (+Decl, "%n is never assigned and has no default value", + (1 => +Decl)); + else + Warning_Msg_Synth (+Decl, "%n is never assigned", (1 => +Decl)); + end if; + end if; + if Def_Val = No_Net then + Def_Val := Build_Const_X (Get_Build (Syn_Inst), + Get_Width (Gate_Net)); + end if; + Connect (Get_Input (Gate, 0), Def_Val); + end if; + + Free_Wire (Vt.Val.W); + end Finalize_Signal; + + procedure Finalize_Declaration + (Syn_Inst : Synth_Instance_Acc; Decl : Node; Is_Subprg : Boolean) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Interface_Variable_Declaration => + if not Get_Instance_Const (Syn_Inst) then + declare + Vt : constant Valtyp := Get_Value (Syn_Inst, Decl); + begin + if Vt /= No_Valtyp + and then Vt.Val.Kind = Value_Wire + then + Finalize_Assignment (Get_Build (Syn_Inst), Vt.Val.W); + Free_Wire (Vt.Val.W); + end if; + end; + end if; + when Iir_Kind_Constant_Declaration => + null; + when Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Signal_Declaration => + pragma Assert (not Is_Subprg); + Finalize_Signal (Syn_Inst, Decl); + when Iir_Kind_Anonymous_Signal_Declaration => + null; + when Iir_Kind_Object_Alias_Declaration => + null; + when Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Declaration => + null; + when Iir_Kind_Procedure_Body + | Iir_Kind_Function_Body => + null; + when Iir_Kind_Non_Object_Alias_Declaration => + null; + when Iir_Kind_Attribute_Declaration => + null; + when Iir_Kind_Attribute_Specification => + null; + when Iir_Kind_Type_Declaration => + null; + when Iir_Kind_Anonymous_Type_Declaration => + null; + when Iir_Kind_Subtype_Declaration => + null; + when Iir_Kind_Component_Declaration => + null; + when Iir_Kind_File_Declaration => + null; + when Iir_Kind_Configuration_Specification => + null; + when Iir_Kind_Psl_Default_Clock => + -- Ignored; directly used by PSL directives. + null; + when Iir_Kind_Signal_Attribute_Declaration => + -- Not supported by synthesis. + null; + when others => + Vhdl.Errors.Error_Kind ("finalize_declaration", Decl); + end case; + end Finalize_Declaration; + + procedure Finalize_Declarations (Syn_Inst : Synth_Instance_Acc; + Decls : Iir; + Is_Subprg : Boolean := False) + is + Decl : Iir; + begin + Decl := Decls; + while Is_Valid (Decl) loop + Finalize_Declaration (Syn_Inst, Decl, Is_Subprg); + + Decl := Get_Chain (Decl); + end loop; + end Finalize_Declarations; +end Synth.Vhdl_Decls; |