-- Instantiation synthesis. -- Copyright (C) 2019 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, write to the Free Software -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. with GNAT.SHA1; with Types; use Types; with Types_Utils; use Types_Utils; with Files_Map; with Name_Table; with Libraries; with Hash; use Hash; with Dyn_Tables; with Interning; with Synthesis; use Synthesis; with Grt.Algos; with Netlists; use Netlists; with Netlists.Builders; use Netlists.Builders; with Netlists.Cleanup; with Netlists.Memories; with Netlists.Expands; with Netlists.Concats; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Errors; with Vhdl.Ieee.Math_Real; with Vhdl.Std_Package; with Synth.Values; use Synth.Values; with Synth.Environment; use Synth.Environment; with Synth.Stmts; use Synth.Stmts; with Synth.Decls; use Synth.Decls; with Synth.Expr; use Synth.Expr; with Synth.Source; use Synth.Source; with Synth.Debugger; package body Synth.Insts is Root_Instance : Synth_Instance_Acc; function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is begin case Mode is when Iir_In_Mode => return Port_In; when Iir_Buffer_Mode | Iir_Out_Mode => return Port_Out; when Iir_Inout_Mode => return Port_Inout; when Iir_Linkage_Mode | Iir_Unknown_Mode => raise Synth_Error; end case; end Mode_To_Port_Kind; -- Parameters that define an instance. type Inst_Params is record -- Declaration: either the entity or the component. Decl : Node; -- Implementation: the architecture or Null_Node for black boxes. Arch : Node; -- Configuration (Null_Node for black boxes). Config : Node; -- Values of generics. Syn_Inst : Synth_Instance_Acc; -- Encoding if the instance name. Encoding : Name_Encoding; end record; type Inst_Object is record Decl : Node; Arch : Node; Config : Node; Syn_Inst : Synth_Instance_Acc; M : Module; -- Encoding if the instance name. Encoding : Name_Encoding; end record; function Hash (Params : Inst_Params) return Hash_Value_Type is Res : Hash_Value_Type; begin Res := Hash_Value_Type (Params.Decl); Res := Res xor Hash_Value_Type (Params.Arch); Res := Res xor Hash_Value_Type (Params.Config); -- TODO: hash generics return Res; end Hash; function Equal (Obj : Inst_Object; Params : Inst_Params) return Boolean is Inter : Node; begin if Obj.Decl /= Params.Decl or else Obj.Arch /= Params.Arch or else Obj.Config /= Params.Config then return False; end if; Inter := Get_Generic_Chain (Params.Decl); while Inter /= Null_Node loop if not Is_Equal (Get_Value (Obj.Syn_Inst, Inter).Val, Get_Value (Params.Syn_Inst, Inter).Val) then return False; end if; Inter := Get_Chain (Inter); end loop; Inter := Get_Port_Chain (Params.Decl); while Inter /= Null_Node loop if not Is_Fully_Constrained_Type (Get_Type (Inter)) then if not Are_Types_Equal (Get_Value (Obj.Syn_Inst, Inter).Typ, Get_Value (Params.Syn_Inst, Inter).Typ) then return False; end if; end if; Inter := Get_Chain (Inter); end loop; return True; end Equal; procedure Hash_Uns64 (C : in out GNAT.SHA1.Context; Val : Uns64) is V : Uns64; S : String (1 .. 8); begin -- Store to S using little endianness. V := Val; for I in S'Range loop S (I) := Character'Val (V and 16#ff#); V := Shift_Right (V, 8); end loop; GNAT.SHA1.Update (C, S); end Hash_Uns64; procedure Hash_Bound (C : in out GNAT.SHA1.Context; B : Bound_Type) is begin Hash_Uns64 (C, Iir_Direction'Pos (B.Dir)); Hash_Uns64 (C, To_Uns64 (Int64 (B.Left))); Hash_Uns64 (C, To_Uns64 (Int64 (B.Right))); end Hash_Bound; procedure Hash_Bounds (C : in out GNAT.SHA1.Context; Typ : Type_Acc) is begin case Typ.Kind is when Type_Vector => Hash_Bound (C, Typ.Vbound); when Type_Array => for I in Typ.Abounds.D'Range loop Hash_Bound (C, Typ.Abounds.D (I)); end loop; when others => raise Internal_Error; end case; end Hash_Bounds; procedure Hash_Const (C : in out GNAT.SHA1.Context; Val : Value_Acc; Typ : Type_Acc) is begin case Val.Kind is when Value_Discrete => Hash_Uns64 (C, To_Uns64 (Val.Scal)); when Value_Float => Hash_Uns64 (C, To_Uns64 (Val.Fp)); when Value_Const_Array => declare El_Typ : constant Type_Acc := Get_Array_Element (Typ); begin -- Bounds. Hash_Bounds (C, Typ); -- Values. for I in Val.Arr.V'Range loop Hash_Const (C, Val.Arr.V (I), El_Typ); end loop; end; when Value_Const_Record => for I in Val.Rec.V'Range loop Hash_Const (C, Val.Rec.V (I), Typ.Rec.E (I).Typ); end loop; when Value_Const => Hash_Const (C, Val.C_Val, Typ); when Value_Alias => if Val.A_Off /= 0 then raise Internal_Error; end if; Hash_Const (C, Val.A_Obj, Typ); when Value_Net | Value_Wire | Value_Array | Value_Record | Value_Access | Value_File => raise Internal_Error; end case; end Hash_Const; function Get_Source_Identifier (Decl : Node) return Name_Id is use Files_Map; use Name_Table; Loc : constant Location_Type := Get_Location (Decl); Len : constant Natural := Get_Name_Length (Get_Identifier (Decl)); subtype Ident_Str is String (1 .. Len); File : Source_File_Entry; Pos : Source_Ptr; Buf : File_Buffer_Acc; begin Location_To_File_Pos (Loc, File, Pos); Buf := Get_File_Source (File); return Get_Identifier (Ident_Str (Buf (Pos .. Pos + Source_Ptr (Len - 1)))); end Get_Source_Identifier; function Create_Module_Name (Params : Inst_Params) return Sname is use GNAT.SHA1; Decl : constant Node := Params.Decl; Id : constant Name_Id := Get_Identifier (Decl); Generics : constant Node := Get_Generic_Chain (Decl); Ports : constant Node := Get_Port_Chain (Decl); Ctxt : GNAT.SHA1.Context; Has_Hash : Boolean; -- Create a buffer, store the entity name. -- For each generic: -- * write the value for integers. -- * write the identifier for enumerated type with only non-extended -- identifiers. -- * hash all other values -- Append the hash if any. use Name_Table; Id_Len : constant Natural := Get_Name_Length (Id); Str_Len : constant Natural := Id_Len + 512; pragma Assert (GNAT.SHA1.Hash_Length = 20); Str : String (1 .. Str_Len + 41); Len : Natural; Gen_Decl : Node; Gen : Valtyp; begin Len := Id_Len; Str (1 .. Len) := Get_Name_Ptr (Id) (1 .. Len); Has_Hash := False; case Params.Encoding is when Name_Hash => Ctxt := GNAT.SHA1.Initial_Context; Gen_Decl := Generics; while Gen_Decl /= Null_Node loop Gen := Get_Value (Params.Syn_Inst, Gen_Decl); case Gen.Val.Kind is when Value_Discrete => declare S : constant String := Uns64'Image (To_Uns64 (Gen.Val.Scal)); begin if Len + S'Length > Str_Len then Has_Hash := True; Hash_Const (Ctxt, Gen.Val, Gen.Typ); else Str (Len + 1 .. Len + S'Length) := S; pragma Assert (Str (Len + 1) = ' '); Str (Len + 1) := '_'; -- Overwrite the space. Len := Len + S'Length; end if; end; when others => Has_Hash := True; Hash_Const (Ctxt, Gen.Val, Gen.Typ); end case; Gen_Decl := Get_Chain (Gen_Decl); end loop; declare Port_Decl : Node; Port_Typ : Type_Acc; begin Port_Decl := Ports; while Port_Decl /= Null_Node loop if not Is_Fully_Constrained_Type (Get_Type (Port_Decl)) then Port_Typ := Get_Value (Params.Syn_Inst, Port_Decl).Typ; Has_Hash := True; Hash_Bounds (Ctxt, Port_Typ); end if; Port_Decl := Get_Chain (Port_Decl); end loop; end; if not Has_Hash and then Generics = Null_Node then -- Simple case: same name. -- TODO: what about two entities with the same identifier but -- declared in two different libraries ? -- TODO: what about extended identifiers ? return New_Sname_User (Id, No_Sname); end if; if Has_Hash then Str (Len + 1) := '_'; Len := Len + 1; Str (Len + 1 .. Len + 40) := GNAT.SHA1.Digest (Ctxt); Len := Len + 40; end if; when Name_Asis | Name_Parameters => return New_Sname_User (Get_Source_Identifier (Decl), No_Sname); when Name_Index => -- TODO. raise Internal_Error; end case; return New_Sname_User (Get_Identifier (Str (1 .. Len)), No_Sname); end Create_Module_Name; -- Create the name of an interface. function Create_Inter_Name (Decl : Node; Enc : Name_Encoding) return Sname is Id : Name_Id; begin case Enc is when Name_Asis | Name_Parameters => Id := Get_Source_Identifier (Decl); when others => Id := Get_Identifier (Decl); end case; return New_Sname_User (Id, No_Sname); end Create_Inter_Name; function Build (Params : Inst_Params) return Inst_Object is Decl : constant Node := Params.Decl; Arch : constant Node := Params.Arch; Imp : Node; Syn_Inst : Synth_Instance_Acc; Inter : Node; Inter_Type : Node; Inter_Typ : Type_Acc; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; Nbr_Params : Param_Nbr; Cur_Module : Module; Val : Valtyp; Id : Module_Id; begin if Get_Kind (Params.Decl) = Iir_Kind_Component_Declaration then pragma Assert (Params.Arch = Null_Node); pragma Assert (Params.Config = Null_Node); Imp := Params.Decl; else pragma Assert (Get_Kind (Params.Config) = Iir_Kind_Block_Configuration); Imp := Params.Arch; end if; -- Create the instance. Syn_Inst := Make_Instance (Root_Instance, Imp, No_Sname); -- Copy values for generics. Inter := Get_Generic_Chain (Decl); Nbr_Params := 0; while Inter /= Null_Node loop -- Bounds or range of the type. Inter_Type := Get_Subtype_Indication (Inter); if Inter_Type /= Null_Node then case Get_Kind (Inter_Type) is when Iir_Kind_Array_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition => Create_Subtype_Object (Syn_Inst, Inter_Type, Get_Subtype_Object (Params.Syn_Inst, Inter_Type)); when others => null; end case; Nbr_Params := Nbr_Params + 1; end if; -- Object. Create_Object (Syn_Inst, Inter, Get_Value (Params.Syn_Inst, Inter)); Inter := Get_Chain (Inter); end loop
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-08 04:06:19 +0000
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). Inter_Typ := Get_Value (Params.Syn_Inst, Inter).Typ; end if; case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => Val := Create_Value_Net (No_Net, Inter_Typ); Nbr_Inputs := Nbr_Inputs + 1; when Port_Out | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); Nbr_Outputs := Nbr_Outputs + 1; end case; Create_Object (Syn_Inst, Inter, Val); Inter := Get_Chain (Inter); end loop; -- Declare module. -- Build it now because it may be referenced for instantiations before -- being synthetized. if Params.Encoding = Name_Parameters and then Nbr_Params > 0 then Id := Id_User_Parameters; else Id := Id_User_None; Nbr_Params := 0; end if; Cur_Module := New_User_Module (Get_Top_Module (Root_Instance), Create_Module_Name (Params), Id, Nbr_Inputs, Nbr_Outputs, Nbr_Params); if Id = Id_User_Parameters then declare use Vhdl.Std_Package; Descs : Param_Desc_Array (1 .. Nbr_Params); Ptype : Param_Type; begin Inter := Get_Generic_Chain (Decl); Nbr_Params := 0; while Inter /= Null_Node loop -- Bounds or range of the type. Inter_Type := Get_Type (Inter); Inter_Type := Get_Base_Type (Inter_Type); if Inter_Type = String_Type_Definition then Ptype := Param_Pval_String; elsif Inter_Type = Time_Type_Definition then Ptype := Param_Pval_Time_Ps; else case Get_Kind (Inter_Type) is when Iir_Kind_Integer_Type_Definition => Ptype := Param_Pval_Integer; when Iir_Kind_Floating_Type_Definition => Ptype := Param_Pval_Real; when others => Ptype := Param_Pval_Vector; end case; end if; Nbr_Params := Nbr_Params + 1; Descs (Nbr_Params) := (Name => Create_Inter_Name (Inter, Params.Encoding), Typ => Ptype); Inter := Get_Chain (Inter); end loop; Set_Params_Desc (Cur_Module, Descs); end; end if; -- Add ports to module. declare Inports : Port_Desc_Array (1 .. Nbr_Inputs); Outports : Port_Desc_Array (1 .. Nbr_Outputs); Pkind : Port_Kind; Desc : Port_Desc; 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)); Vt := Get_Value (Syn_Inst, Inter); Desc := (Name => Create_Inter_Name (Inter, Params.Encoding), Is_Inout => Pkind = Port_Inout, W => Get_Type_Width (Vt.Typ)); case Pkind is when Port_In => Nbr_Inputs := Nbr_Inputs + 1; Inports (Nbr_Inputs) := Desc; when Port_Out | Port_Inout => Nbr_Outputs := Nbr_Outputs + 1; Outports (Nbr_Outputs) := Desc; end case; Inter := Get_Chain (Inter); end loop; pragma Assert (Nbr_Inputs = Inports'Last); pragma Assert (Nbr_Outputs = Outports'Last); Set_Ports_Desc (Cur_Module, Inports, Outports); end; return Inst_Object'(Decl => Decl, Arch => Arch, Config => Params.Config, Syn_Inst => Syn_Inst, M => Cur_Module, Encoding => Params.Encoding); end Build; package Insts_Interning is new Interning (Params_Type => Inst_Params, Object_Type => Inst_Object, Hash => Hash, Build => Build, Equal => Equal); procedure Synth_Individual_Prefix (Syn_Inst : Synth_Instance_Acc; Inter_Inst : Synth_Instance_Acc; Formal : Node; Off : out Uns32; Typ : out Type_Acc) is begin case Get_Kind (Formal) is when Iir_Kind_Interface_Signal_Declaration => Off := 0; 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); when Iir_Kind_Selected_Element => declare Idx : constant Iir_Index32 := Get_Element_Position (Get_Named_Entity (Formal)); begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); Off := Off + Typ.Rec.E (Idx + 1).Off; Typ := Typ.Rec.E (Idx + 1).Typ; end; when Iir_Kind_Indexed_Name => declare Voff : Net; Arr_Off : Uns32; W : Width; begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); Synth_Indexed_Name (Syn_Inst, Formal, Typ, Voff, Arr_Off, W); if Voff /= No_Net then raise Internal_Error; end if; Off := Off + Arr_Off; Typ := Get_Array_Element (Typ); end; when Iir_Kind_Slice_Name => declare Pfx_Bnd : Bound_Type; El_Typ : Type_Acc; Res_Bnd : Bound_Type; Sl_Voff : Net; Sl_Off : Uns32; Wd : Uns32; begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); Get_Onedimensional_Array_Bounds (Typ, Pfx_Bnd, El_Typ); Synth_Slice_Suffix (Syn_Inst, Formal, Pfx_Bnd, El_Typ.W, Res_Bnd, Sl_Voff, Sl_Off, Wd); if Sl_Voff /= No_Net then raise Internal_Error; end if; Off := Off + Sl_Off; Typ := Create_Onedimensional_Array_Subtype (Typ, Res_Bnd); end; when others => Vhdl.Errors.Error_Kind ("synth_individual_prefix", Formal); end case; end Synth_Individual_Prefix; type Value_Offset_Record is record Off : Uns32; Val : Valtyp; end record; package Value_Offset_Tables is new Dyn_Tables (Table_Component_Type => Value_Offset_Record, Table_Index_Type => Natural, Table_Low_Bound => 1); procedure Sort_Value_Offset (Els : Value_Offset_Tables.Instance) is function Lt (Op1, Op2 : Natural) return Boolean is begin return Els.Table (Op1).Off < Els.Table (Op2).Off; end Lt; procedure Swap (From : Natural; To : Natural) is T : constant Value_Offset_Record := Els.Table (From); begin Els.Table (From) := Els.Table (To); Els.Table (To) := T; end Swap; procedure Heap_Sort is new Grt.Algos.Heap_Sort (Lt => Lt, Swap => Swap); begin Heap_Sort (Value_Offset_Tables.Last (Els)); end Sort_Value_Offset; function Synth_Individual_Input_Assoc (Syn_Inst : Synth_Instance_Acc; Assoc : Node; Inter_Inst : Synth_Instance_Acc) return Net is use Netlists.Concats; Iassoc : Node; V : Valtyp; Off : Uns32; Typ : Type_Acc; Els : Value_Offset_Tables.Instance; Concat : Concat_Type; N_Off : Uns32; N : Net; begin Value_Offset_Tables.Init (Els, 16); Iassoc := Get_Chain (Assoc); while Iassoc /= Null_Node and then not Get_Whole_Association_Flag (Iassoc) loop -- For each individual assoc: -- 1. compute type and offset Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Formal (Iassoc), Off, Typ); -- 2. synth expression V := Synth_Expression_With_Type (Syn_Inst, Get_Actual (Iassoc), Typ); -- 3. save in a table Value_Offset_Tables.Append (Els, (Off, V)); Iassoc := Get_Chain (Iassoc); end loop; -- Then: -- 1. sort table by offset Sort_Value_Offset (Els); -- 2. concat N_Off := 0; for I in Value_Offset_Tables.First .. Value_Offset_Tables.Last (Els) loop pragma Assert (N_Off = Els.Table (I).Off); V := Els.Table (I).Val; N_Off := N_Off + V.Typ.W; Append (Concat, Get_Net (V)); end loop; Value_Offset_Tables.Free (Els); -- 3. connect Build (Get_Build (Syn_Inst), Concat, N); return N; end Synth_Individual_Input_Assoc; function Synth_Input_Assoc (Syn_Inst : Synth_Instance_Acc; Assoc : Node; Inter_Inst : Synth_Instance_Acc; Inter : Node) return Net is Actual : Node; Formal_Typ : Type_Acc; Act_Inst : Synth_Instance_Acc; Act : Valtyp; begin case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is when Iir_Kind_Association_Element_Open => Actual := Get_Default_Value (Inter); Act_Inst := Inter_Inst; when Iir_Kind_Association_Element_By_Expression => Actual := Get_Actual (Assoc); if Get_Kind (Actual) = Iir_Kind_Reference_Name then -- Skip inserted anonymous signal declaration. -- FIXME: simply do not insert it ? Actual := Get_Named_Entity (Actual); pragma Assert (Get_Kind (Actual) = Iir_Kind_Anonymous_Signal_Declaration); Actual := Get_Expression (Actual); end if; Act_Inst := Syn_Inst; when Iir_Kind_Association_Element_By_Individual => return Synth_Individual_Input_Assoc (Syn_Inst, Assoc, Inter_Inst); end case; Formal_Typ := Get_Subtype_Object (Inter_Inst, Get_Type (Inter)); Act := Synth_Expression_With_Type (Act_Inst, Actual, Formal_Typ); return Get_Net (Act); end Synth_Input_Assoc; procedure Synth_Individual_Output_Assoc (Outp : Net; Syn_Inst : Synth_Instance_Acc; Assoc : Node; Inter_Inst : Synth_Instance_Acc) is Iassoc : Node; V : Valtyp; Off : Uns32; Typ : Type_Acc; O : Net; Port : Net; begin Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp); Iassoc := Get_Chain (Assoc); while Iassoc /= Null_Node and then not Get_Whole_Association_Flag (Iassoc) loop -- For each individual assoc: -- 1. compute type and offset Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Formal (Iassoc), Off, Typ); -- 2. Extract the value. O := Build_Extract (Get_Build (Syn_Inst), Port, Off, Typ.W); V := Create_Value_Net (O, Typ); -- 3. Assign. Synth_Assignment (Syn_Inst, Get_Actual (Iassoc), V, Iassoc); Iassoc := Get_Chain (Iassoc); end loop; end Synth_Individual_Output_Assoc; procedure Synth_Output_Assoc (Outp : Net; Syn_Inst : Synth_Instance_Acc; Assoc : Node; Inter_Inst : Synth_Instance_Acc; Inter : Node) is Actual : Node; Formal_Typ : Type_Acc; Port : Net; O : Valtyp; begin case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => -- Not connected. return; when Iir_Kind_Association_Element_By_Expression => Actual := Get_Actual (Assoc); when others => Synth_Individual_Output_Assoc (Outp, Syn_Inst, Assoc, Inter_Inst); return; end case; Formal_Typ := Get_Value (Inter_Inst, Inter).Typ; -- Create a port gate (so that is has a name). Port := Builders.Build_Port (Get_Build (Syn_Inst), Outp); O := Create_Value_Net (Port, Formal_Typ); -- Assign the port output to the actual (a net). Synth_Assignment (Syn_Inst, Actual, O, Assoc); end Synth_Output_Assoc; -- Subprogram used for instantiation (direct or by component). -- PORTS_ASSOC belong to SYN_INST. procedure Synth_Instantiate_Module (Syn_Inst : Synth_Instance_Acc; Inst : Instance; Inst_Obj : Inst_Object; Ports_Assoc : Node) is -- Instantiate the module -- Elaborate ports + map aspect for the inputs (component then entity) -- Elaborate ports + map aspect for the outputs (entity then component) Assoc : Node; Assoc_Inter : Node; Inter : Node; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; begin Assoc := Ports_Assoc; Assoc_Inter := Get_Port_Chain (Inst_Obj.Decl); Nbr_Inputs := 0; Nbr_Outputs := 0; while Is_Valid (Assoc) loop if Get_Whole_Association_Flag (Assoc) then Inter := Get_Association_Interface (Assoc, Assoc_Inter); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => -- Connect the net to the input. Connect (Get_Input (Inst, Nbr_Inputs), Synth_Input_Assoc (Syn_Inst, Assoc, Inst_Obj.Syn_Inst, Inter)); Nbr_Inputs := Nbr_Inputs + 1; when Port_Out | Port_Inout => Synth_Output_Assoc (Get_Output (Inst, Nbr_Outputs), Syn_Inst, Assoc, Inst_Obj.Syn_Inst, Inter); Nbr_Outputs := Nbr_Outputs + 1; end case; end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; if Inst_Obj.Encoding = Name_Parameters then declare Inter : Node; Vt : Valtyp; Vec : Logvec_Array_Acc; Len : Uns32; Off : Uns32; Has_Zx : Boolean; Pv : Pval; Idx : Param_Idx; begin Idx := 0; Inter := Get_Generic_Chain (Inst_Obj.Decl); while Inter /= Null_Node loop 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 (Vt, Vec.all, Off, Has_Zx); if Has_Zx then Pv := Create_Pval4 (Vt.Typ.W); else Pv := Create_Pval2 (Vt.Typ.W); end if; for I in 0 .. Len - 1 loop Write_Pval (Pv, I, Vec (Digit_Index (I))); end loop; Set_Param_Pval (Inst, Idx, Pv); Inter := Get_Chain (Inter); Idx := Idx + 1; end loop; end; end if; end Synth_Instantiate_Module; function Synth_Port_Association_Type (Sub_Inst : Synth_Instance_Acc; Syn_Inst : Synth_Instance_Acc; Inter : Node; Assoc : Node) return Type_Acc is begin if not Is_Fully_Constrained_Type (Get_Type (Inter)) then -- TODO -- Find the association for this interface -- * if individual assoc: get type -- * if whole assoc: get type from object. if Assoc = Null_Node then raise Internal_Error; end if; case Get_Kind (Assoc) is when Iir_Kind_Association_Element_By_Expression => return Synth_Type_Of_Object (Syn_Inst, Get_Actual (Assoc)); when others => raise Internal_Error; end case; else Synth_Declaration_Type (Sub_Inst, Inter); return Get_Subtype_Object (Sub_Inst, Get_Type (Inter)); end if; end Synth_Port_Association_Type; procedure Synth_Ports_Association_Type (Sub_Inst : Synth_Instance_Acc; Syn_Inst : Synth_Instance_Acc; Inter_Chain : Node; Assoc_Chain : Node) is Inter : Node; Assoc : Node; Assoc_Inter : Node; Val : Valtyp; Inter_Typ : Type_Acc; begin Assoc := Assoc_Chain; Assoc_Inter := Inter_Chain; while Is_Valid (Assoc) loop Inter := Get_Association_Interface (Assoc, Assoc_Inter); if Get_Whole_Association_Flag (Assoc) then Inter_Typ := Synth_Port_Association_Type (Sub_Inst, Syn_Inst, Inter, Assoc); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => Val := Create_Value_Net (No_Net, Inter_Typ); when Port_Out | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); end case; Create_Object (Sub_Inst, Inter, Val); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; end Synth_Ports_Association_Type; procedure Synth_Direct_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node; Ent : Node; Arch : Node; Config : Node) is Sub_Inst : Synth_Instance_Acc; Inst_Obj : Inst_Object; Inst : Instance; Enc : Name_Encoding; begin -- Elaborate generic + map aspect Sub_Inst := Make_Instance (Syn_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname)); Synth_Generics_Association (Sub_Inst, Syn_Inst, Get_Generic_Chain (Ent), Get_Generic_Map_Aspect_Chain (Stmt)); -- Elaborate port types. Synth_Ports_Association_Type (Sub_Inst, Syn_Inst, Get_Port_Chain (Ent), Get_Port_Map_Aspect_Chain (Stmt)); if Arch /= Null_Node then -- For whiteboxes: append parameters or/and hash. Enc := Name_Hash; else -- For blackboxes: define the parameters. Enc := Name_Parameters; end if; -- Search if corresponding module has already been used. -- If not create a new module -- * create a name from the generics and the library -- * create inputs/outputs -- * add it to the list of module to be synthesized. Inst_Obj := Insts_Interning.Get ((Decl => Ent, Arch => Arch, Config => Config, Syn_Inst => Sub_Inst, Encoding => Enc)); -- TODO: free sub_inst. Inst := New_Instance (Get_Instance_Module (Syn_Inst), Inst_Obj.M, New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst))); Set_Location (Inst, Stmt); Synth_Instantiate_Module (Syn_Inst, Inst, Inst_Obj, Get_Port_Map_Aspect_Chain (Stmt)); end Synth_Direct_Instantiation_Statement; procedure Synth_Design_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Aspect : constant Iir := Get_Instantiated_Unit (Stmt); Arch : Node; Ent : Node; Config : Node; begin -- Load configured entity + architecture case Iir_Kinds_Entity_Aspect (Get_Kind (Aspect)) is when Iir_Kind_Entity_Aspect_Entity => Arch := Get_Architecture (Aspect); if Arch = Null_Node then Arch := Libraries.Get_Latest_Architecture (Get_Entity (Aspect)); else Arch := Strip_Denoting_Name (Arch); end if; Config := Get_Library_Unit (Get_Default_Configuration_Declaration (Arch)); when Iir_Kind_Entity_Aspect_Configuration => Config := Get_Configuration (Aspect); Arch := Get_Block_Specification (Get_Block_Configuration (Config)); when Iir_Kind_Entity_Aspect_Open => return; end case; Config := Get_Block_Configuration (Config); Ent := Get_Entity (Arch); Synth_Direct_Instantiation_Statement (Syn_Inst, Stmt, Ent, Arch, Config); end Synth_Design_Instantiation_Statement; procedure Synth_Blackbox_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Comp : constant Node := Get_Named_Entity (Get_Instantiated_Unit (Stmt)); begin Synth_Direct_Instantiation_Statement (Syn_Inst, Stmt, Comp, Null_Node, Null_Node); end Synth_Blackbox_Instantiation_Statement; procedure Create_Component_Wire (Ctxt : Context_Acc; Inter : Node; Val : Valtyp; Pfx_Name : Sname) is Value : Net; W : Width; begin case Val.Val.Kind is when Value_Wire => -- Create a gate for the output, so that it could be read. Val.Val.W := Alloc_Wire (Wire_Output, Inter); W := Get_Type_Width (Val.Typ); Value := Build_Signal (Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W); Set_Wire_Gate (Val.Val.W, Value); when others => raise Internal_Error; end case; end Create_Component_Wire; procedure Synth_Component_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Component : constant Node := Get_Named_Entity (Get_Instantiated_Unit (Stmt)); Config : constant Node := Get_Component_Configuration (Stmt); Bind : constant Node := Get_Binding_Indication (Config); Aspect : constant Node := Get_Entity_Aspect (Bind); Comp_Inst : Synth_Instance_Acc; Ent : Node; Arch : Node; Sub_Config : Node; Sub_Inst : Synth_Instance_Acc; Inst_Obj : Inst_Object; Inst : Instance; Inst_Name : Sname; begin pragma Assert (Get_Component_Configuration (Stmt) /= Null_Node); pragma Assert (Get_Kind (Aspect) = Iir_Kind_Entity_Aspect_Entity); Inst_Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); -- Create the sub-instance for the component -- Elaborate generic + map aspect Comp_Inst := Make_Instance (Syn_Inst, Component, New_Sname_User (Get_Identifier (Component), No_Sname)); Synth_Generics_Association (Comp_Inst, Syn_Inst, Get_Generic_Chain (Component), Get_Generic_Map_Aspect_Chain (Stmt)); -- Create objects for the inputs and the outputs of the component, -- assign inputs (that's nets) and create wires for outputs. declare Assoc : Node; Assoc_Inter : Node; Inter : Node; Inter_Typ : Type_Acc; Val : Valtyp; N : Net; begin Assoc := Get_Port_Map_Aspect_Chain (Stmt); Assoc_Inter := Get_Port_Chain (Component); while Is_Valid (Assoc) loop if Get_Whole_Association_Flag (Assoc) then Inter := Get_Association_Interface (Assoc, Assoc_Inter); 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_Typ); when Port_Out | Port_Inout => 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); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; end; -- Extract entity/architecture instantiated by the component. case Get_Kind (Aspect) is when Iir_Kind_Entity_Aspect_Entity => Ent := Get_Entity (Aspect); Arch := Get_Architecture (Aspect); when others => Vhdl.Errors.Error_Kind ("Synth_Component_Instantiation_Statement(2)", Aspect); end case; if Arch = Null_Node then Arch := Libraries.Get_Latest_Architecture (Ent); Sub_Config := Get_Library_Unit (Get_Default_Configuration_Declaration (Arch)); Sub_Config := Get_Block_Configuration (Sub_Config); else raise Internal_Error; end if; -- Elaborate generic + map aspect for the entity instance. Sub_Inst := Make_Instance (Comp_Inst, Ent, New_Sname_User (Get_Identifier (Ent), No_Sname)); Synth_Generics_Association (Sub_Inst, Comp_Inst, Get_Generic_Chain (Ent), Get_Generic_Map_Aspect_Chain (Bind)); Synth_Ports_Association_Type (Sub_Inst, Comp_Inst, Get_Port_Chain (Ent), Get_Port_Map_Aspect_Chain (Bind)); -- Search if corresponding module has already been used. -- If not create a new module -- * create a name from the generics and the library -- * create inputs/outputs -- * add it to the list of module to be synthesized. Inst_Obj := Insts_Interning.Get ((Decl => Ent, Arch => Arch, Config => Sub_Config, Syn_Inst => Sub_Inst, Encoding => Name_Hash)); -- TODO: free sub_inst. Inst := New_Instance (Get_Instance_Module (Syn_Inst), Inst_Obj.M, Inst_Name); Synth_Instantiate_Module (Comp_Inst, Inst, Inst_Obj, Get_Port_Map_Aspect_Chain (Bind)); -- Connect out from component to instance. -- Instantiate the module -- Elaborate ports + map aspect for the inputs (component then entity) -- Elaborate ports + map aspect for the outputs (entity then component) declare Assoc : Node; Assoc_Inter : Node; Inter : Node; Port : Net; O : Valtyp; Nbr_Outputs : Port_Nbr; begin Assoc := Get_Port_Map_Aspect_Chain (Stmt); Assoc_Inter := Get_Port_Chain (Component); Nbr_Outputs := 0; while Is_Valid (Assoc) loop if Get_Whole_Association_Flag (Assoc) then Inter := Get_Association_Interface (Assoc, Assoc_Inter); if Mode_To_Port_Kind (Get_Mode (Inter)) = Port_Out then O := Get_Value (Comp_Inst, Inter); Port := Get_Net (O); Synth_Output_Assoc (Port, Syn_Inst, Assoc, Comp_Inst, Inter); Nbr_Outputs := Nbr_Outputs + 1; end if; end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; end; end Synth_Component_Instantiation_Statement; procedure Synth_Dependencies (Parent_Inst : Synth_Instance_Acc; Unit : Node) is Dep_List : constant Node_List := Get_Dependence_List (Unit); Dep_It : List_Iterator; Dep : Node; Dep_Unit : Node; begin Dep_It := List_Iterate (Dep_List); while Is_Valid (Dep_It) loop Dep := Get_Element (Dep_It); if Get_Kind (Dep) = Iir_Kind_Design_Unit and then not Get_Elab_Flag (Dep) then Set_Elab_Flag (Dep, True); Synth_Dependencies (Parent_Inst, Dep); Dep_Unit := Get_Library_Unit (Dep); case Iir_Kinds_Library_Unit (Get_Kind (Dep_Unit)) is when Iir_Kind_Entity_Declaration => null; when Iir_Kind_Configuration_Declaration => null; when Iir_Kind_Context_Declaration => null; when Iir_Kind_Package_Declaration => declare Bod : constant Node := Get_Package_Body (Dep_Unit); Bod_Unit : Node; begin Synth_Package_Declaration (Parent_Inst, Dep_Unit); -- Do not try to elaborate math_real body: there are -- functions with loop. Currently, try create signals, -- which is not possible during package elaboration. if Bod /= Null_Node and then Dep_Unit /= Vhdl.Ieee.Math_Real.Math_Real_Pkg then Bod_Unit := Get_Design_Unit (Bod); Synth_Dependencies (Parent_Inst, Bod_Unit); Synth_Package_Body (Parent_Inst, Dep_Unit, Bod); end if; end; when Iir_Kind_Package_Instantiation_Declaration => Synth_Package_Instantiation (Parent_Inst, Dep_Unit); when Iir_Kind_Package_Body => null; when Iir_Kind_Architecture_Body => null; when Iir_Kinds_Verification_Unit => null; end case; end if; Next (Dep_It); end loop; end Synth_Dependencies; procedure Synth_Top_Entity (Global_Instance : Synth_Instance_Acc; Arch : Node; Config : Node; Encoding : Name_Encoding; Inst : out Synth_Instance_Acc) is Entity : constant Node := Get_Entity (Arch); Syn_Inst : Synth_Instance_Acc; Inter : Node; Inter_Typ : Type_Acc; Inst_Obj : Inst_Object; Val : Valtyp; begin Root_Instance := Global_Instance; Insts_Interning.Init; if Flags.Flag_Debug_Init then Synth.Debugger.Debug_Init; end if; -- Dependencies first. Synth_Dependencies (Global_Instance, Get_Design_Unit (Entity)); Synth_Dependencies (Global_Instance, Get_Design_Unit (Arch)); Syn_Inst := Make_Instance (Global_Instance, Arch, New_Sname_User (Get_Identifier (Entity), No_Sname)); -- Compute generics. Inter := Get_Generic_Chain (Entity); while Is_Valid (Inter) loop Synth_Declaration_Type (Syn_Inst, Inter); declare Val : Valtyp; Inter_Typ : Type_Acc; begin Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); Val := Synth_Expression_With_Type (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); end loop; -- Elaborate port types. -- FIXME: what about unconstrained ports ? Get the type from the -- association. Inter := Get_Port_Chain (Entity); while Is_Valid (Inter) loop if not Is_Fully_Constrained_Type (Get_Type (Inter)) then -- TODO raise Internal_Error; end if; Synth_Declaration_Type (Syn_Inst, 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); when Port_Out | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); end case; Create_Object (Syn_Inst, Inter, Val); Inter := Get_Chain (Inter); end loop; -- Search if corresponding module has already been used. -- If not create a new module -- * create a name from the generics and the library -- * create inputs/outputs -- * add it to the list of module to be synthesized. Inst_Obj := Insts_Interning.Get ((Decl => Entity, Arch => Arch, Config => Get_Block_Configuration (Config), Syn_Inst => Syn_Inst, Encoding => Encoding)); Inst := Inst_Obj.Syn_Inst; end Synth_Top_Entity; procedure Create_Input_Wire (Self_Inst : Instance; Idx : Port_Idx; Val : Value_Acc) is begin pragma Assert (Val.Kind = Value_Net); Val.N := Get_Output (Self_Inst, Idx); end Create_Input_Wire; procedure Create_Output_Wire (Syn_Inst : Synth_Instance_Acc; Self_Inst : Instance; Inter : Node; Idx : Port_Idx; Val : Value_Acc) is Default : constant Node := Get_Default_Value (Inter); Desc : constant Port_Desc := Get_Output_Desc (Get_Module (Self_Inst), Idx); Inter_Typ : Type_Acc; Value : Net; Init : Valtyp; Inp : Input; begin pragma Assert (Val.Kind = Value_Wire); -- Create a gate for the output, so that it could be read. Val.W := Alloc_Wire (Wire_Output, Inter); -- pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); Inp := Get_Input (Self_Inst, Idx); if Desc.Is_Inout then if Default /= Null_Node then -- TODO: initialized inout. raise Internal_Error; end if; declare Io_Inst : Instance; begin Io_Inst := Builders.Build_Inout (Build_Context, Desc.W); -- Connect port1 of gate inout to the pin. Connect (Inp, Get_Output (Io_Inst, 1)); -- And port0 of the gate will be use to read from the pin. Value := Get_Output (Io_Inst, 0); end; else if Default /= Null_Node then Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter)); Init := Synth_Expression_With_Type (Syn_Inst, Default, Inter_Typ); Init := Synth_Subtype_Conversion (Init, Inter_Typ, False, Inter); Value := Builders.Build_Ioutput (Build_Context, Get_Net (Init)); else Value := Builders.Build_Output (Build_Context, Desc.W); end if; Connect (Inp, Value); end if; Set_Location (Value, Inter); Set_Wire_Gate (Val.W, Value); end Create_Output_Wire; procedure Apply_Block_Configuration (Cfg : Node; Blk : Node) is Item : Node; begin -- Be sure CFG applies to BLK. pragma Assert (Get_Block_From_Block_Specification (Get_Block_Specification (Cfg)) = Blk); Clear_Instantiation_Configuration (Blk); Item := Get_Configuration_Item_Chain (Cfg); while Item /= Null_Node loop case Get_Kind (Item) is when Iir_Kind_Component_Configuration => declare List : constant Iir_Flist := Get_Instantiation_List (Item); El : Node; Inst : Node; begin for I in Flist_First .. Flist_Last (List) loop El := Get_Nth_Element (List, I); Inst := Get_Named_Entity (El); pragma Assert (Get_Kind (Inst) = Iir_Kind_Component_Instantiation_Statement); pragma Assert (Get_Component_Configuration (Inst) = Null_Node); Set_Component_Configuration (Inst, Item); end loop; end; when Iir_Kind_Block_Configuration => declare Sub_Blk : constant Node := Get_Block_From_Block_Specification (Get_Block_Specification (Item)); begin case Get_Kind (Sub_Blk) is when Iir_Kind_Generate_Statement_Body => -- Linked chain. Set_Prev_Block_Configuration (Item, Get_Generate_Block_Configuration (Sub_Blk)); Set_Generate_Block_Configuration (Sub_Blk, Item); when Iir_Kind_Block_Statement => Set_Block_Block_Configuration (Sub_Blk, Item); when others => Vhdl.Errors.Error_Kind ("apply_block_configuration(blk)", Sub_Blk); end case; end; when others => Vhdl.Errors.Error_Kind ("apply_block_configuration", Item); end case; Item := Get_Chain (Item); end loop; end Apply_Block_Configuration; procedure Synth_Verification_Units (Syn_Inst : Synth_Instance_Acc; Parent : Node) is Unit : Node; begin Unit := Get_Bound_Vunit_Chain (Parent); while Unit /= Null_Node loop Synth_Verification_Unit (Syn_Inst, Unit); Unit := Get_Bound_Vunit_Chain (Unit); end loop; end Synth_Verification_Units; procedure Synth_Instance (Inst : Inst_Object) is Entity : constant Node := Inst.Decl; Arch : constant Node := Inst.Arch; Syn_Inst : constant Synth_Instance_Acc := Inst.Syn_Inst; Self_Inst : Instance; Inter : Node; Vt : Valtyp; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; begin if Arch = Null_Node then -- Black box. return; end if; Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch)); Set_Instance_Module (Syn_Inst, Inst.M); Self_Inst := Get_Self_Instance (Inst.M); Set_Location (Self_Inst, Entity); -- Create wires for inputs and outputs. Inter := Get_Port_Chain (Entity); Nbr_Inputs := 0; Nbr_Outputs := 0; while Is_Valid (Inter) loop 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, Vt.Val); Nbr_Inputs := Nbr_Inputs + 1; when Port_Out | Port_Inout => Create_Output_Wire (Syn_Inst, Self_Inst, Inter, Nbr_Outputs, Vt.Val); Nbr_Outputs := Nbr_Outputs + 1; end case; Inter := Get_Chain (Inter); end loop; -- Apply configuration. -- FIXME: what about inner block configuration ? pragma Assert (Get_Kind (Inst.Config) = Iir_Kind_Block_Configuration); Apply_Block_Configuration (Inst.Config, Arch); Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Entity)); if not Is_Error (Syn_Inst) then Synth_Concurrent_Statements (Syn_Inst, Get_Concurrent_Statement_Chain (Entity)); end if; if not Is_Error (Syn_Inst) then Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); end if; if not Is_Error (Syn_Inst) then Synth_Concurrent_Statements (Syn_Inst, Get_Concurrent_Statement_Chain (Arch)); end if; if not Is_Error (Syn_Inst) then Synth_Verification_Units (Syn_Inst, Entity); end if; if not Is_Error (Syn_Inst) then Synth_Verification_Units (Syn_Inst, Arch); end if; Finalize_Assignments (Get_Build (Syn_Inst)); Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); -- Remove unused gates. This is not only an optimization but also -- a correctness point: there might be some unsynthesizable gates, like -- the one created for 'rising_egde (clk) and not rst'. if not Synth.Flags.Flag_Debug_Nocleanup then -- Netlists.Cleanup.Remove_Unconnected_Instances (Inst.M); Netlists.Cleanup.Mark_And_Sweep (Inst.M); Netlists.Cleanup.Remove_Output_Gates (Inst.M); end if; if not Synth.Flags.Flag_Debug_Nomemory then Netlists.Memories.Extract_Memories2 (Get_Build (Syn_Inst), Inst.M); -- Remove remaining clock edge gates. Netlists.Cleanup.Mark_And_Sweep (Inst.M); end if; if not Synth.Flags.Flag_Debug_Noexpand then Netlists.Expands.Expand_Gates (Get_Build (Syn_Inst), Inst.M); end if; end Synth_Instance; procedure Synth_All_Instances is use Insts_Interning; Idx : Index_Type; begin Idx := First_Index; while Idx <= Last_Index loop Synth_Instance (Get_By_Index (Idx)); Idx := Idx + 1; end loop; end Synth_All_Instances; end Synth.Insts;