-- 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, see . with GNAT.SHA1; with Types; use Types; with Types_Utils; use Types_Utils; with Name_Table; with Std_Names; 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.Concats; with Netlists.Folds; with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; with Elab.Vhdl_Values; use Elab.Vhdl_Values; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Errors; with Vhdl.Evaluation; with Vhdl.Ieee.Math_Real; with Vhdl.Std_Package; with Elab.Memtype; use Elab.Memtype; with Elab.Vhdl_Files; with Elab.Debugger; with Elab.Vhdl_Errors; with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env; with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; with Synth.Vhdl_Decls; use Synth.Vhdl_Decls; with Synth.Vhdl_Expr; use Synth.Vhdl_Expr; with Synth.Source; use Synth.Source; with Synth.Errors; with Synth.Vhdl_Context; use Synth.Vhdl_Context; package body Synth.Vhdl_Insts is Global_Base_Instance : Base_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), Get_Value (Params.Syn_Inst, Inter)) 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_Memory (C : in out GNAT.SHA1.Context; M : Memory_Ptr; Typ : Type_Acc) is S : String (1 .. Natural (Typ.Sz)); for S'Address use M (0)'Address; pragma Import (Ada, S); begin GNAT.SHA1.Update (C, S); end Hash_Memory; procedure Hash_Bound (C : in out GNAT.SHA1.Context; B : Bound_Type) is begin Hash_Uns64 (C, Direction_Type'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_Memory => Hash_Memory (C, Val.Mem, Typ); when Value_Const => Hash_Const (C, Val.C_Val, Typ); when Value_Alias => if Val.A_Off /= (0, 0) then raise Internal_Error; end if; Hash_Const (C, Val.A_Obj, Typ); when Value_Net | Value_Wire | Value_Signal | Value_File => raise Internal_Error; end case; end Hash_Const; 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; -- True in practice (and used to set the length of STR, but doesn't work -- anymore with gcc/gnat 11. -- 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); Strip_Const (Gen); case Gen.Typ.Kind is when Type_Discrete => declare S : constant String := Uns64'Image (To_Uns64 (Read_Discrete (Gen))); 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 Get_Encoded_Name_Id (Decl : Node; Enc : Name_Encoding) return Name_Id is begin case Enc is when Name_Asis | Name_Parameters => return Get_Source_Identifier (Decl); when others => return Get_Identifier (Decl); end case; end Get_Encoded_Name_Id; -- Create the name of an interface. function Create_Inter_Name (Decl : Node; Enc : Name_Encoding) return Sname is begin return New_Sname_User (Get_Encoded_Name_Id (Decl, Enc), No_Sname); end Create_Inter_Name; -- Return the number of ports for a type. A record type create one -- port per immediate subelement. Sub-records are not expanded. function Count_Nbr_Ports (Typ : Type_Acc) return Port_Nbr is begin case Typ.Kind is when Type_Bit | Type_Logic | Type_Discrete | Type_Float | Type_Vector | Type_Unbounded_Vector | Type_Array | Type_Unbounded_Array => return 1; when Type_Record | Type_Unbounded_Record => return Port_Nbr (Typ.Rec.Len); when Type_Slice | Type_Access | Type_File | Type_Protected => raise Internal_Error; end case; end Count_Nbr_Ports; procedure Build_Ports_Desc (Descs : in out Port_Desc_Array; Idx : in out Port_Nbr; Pkind : Port_Kind; Encoding : Name_Encoding; Typ : Type_Acc; Inter : Node) is Port_Sname : Sname; begin Port_Sname := Create_Inter_Name (Inter, Encoding); case Typ.Kind is when Type_Bit | Type_Logic | Type_Discrete | Type_Float | Type_Vector | Type_Unbounded_Vector | Type_Array | Type_Unbounded_Array => Idx := Idx + 1; Descs (Idx) := (Name => Port_Sname, Dir => Pkind, W => Get_Type_Width (Typ)); when Type_Record | Type_Unbounded_Record => declare Els : constant Node_Flist := Get_Elements_Declaration_List (Get_Type (Inter)); El : Node; begin for I in Typ.Rec.E'Range loop El := Get_Nth_Element (Els, Natural (I - 1)); Idx := Idx + 1; Descs (Idx) := (Name => New_Sname_User (Get_Encoded_Name_Id (El, Encoding), Port_Sname), Dir => Pkind, W => Get_Type_Width (Typ.Rec.E (I).Typ)); end loop; end; when Type_Slice | Type_Access | Type_File | Type_Protected => raise Internal_Error; end case; end Build_Ports_Desc; function Build (Params : Inst_Params) return Inst_Object is Decl : constant Node := Params.Decl; Arch : constant Node := Params.Arch; Inter : 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 -- Copy values for generics. Inter := Get_Generic_Chain (Decl); Nbr_Params := 0; while Inter /= Null_Node loop Nbr_Params := Nbr_Params + 1; Inter := Get_Chain (Inter); end loop; -- Allocate values and count inputs and outputs Inter := Get_Port_Chain (Decl); Nbr_Inputs := 0; Nbr_Outputs := 0; while Is_Valid (Inter) loop Inter_Typ := Get_Value (Params.Syn_Inst, Inter).Typ; case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => Val := Create_Value_Net (No_Net, Inter_Typ); Nbr_Inputs := Nbr_Inputs + Count_Nbr_Ports (Inter_Typ); when Port_Out | Port_Inout => Val := Create_Value_Wire (No_Wire_Id, Inter_Typ); Nbr_Outputs := Nbr_Outputs + Count_Nbr_Ports (Inter_Typ); end case; Replace_Signal (Params.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 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. Ptype := Type_To_Param_Type (Get_Type (Inter)); 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; 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 (Params.Syn_Inst, Inter); case Pkind is when Port_In => Build_Ports_Desc (Inports, Nbr_Inputs, Pkind, Params.Encoding, Vt.Typ, Inter); when Port_Out | Port_Inout => Build_Ports_Desc (Outports, Nbr_Outputs, Pkind, Params.Encoding, Vt.Typ, Inter); 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; Set_Extra (Params.Syn_Inst, Global_Base_Instance, No_Sname); return Inst_Object'(Decl => Decl, Arch => Arch, Config => Params.Config, Syn_Inst => Params.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); function Is_Arch_Black_Box (Arch : Node) return Boolean is use Vhdl.Std_Package; use Elab.Vhdl_Errors; Value : Node; Spec : Node; Attr_Decl : Node; Val : Node; begin if Arch = Null_Node then return True; end if; -- A little bit like Find_Attribute_Value, but recoded to handle -- many attributes. Value := Get_Attribute_Value_Chain (Arch); while Value /= Null_Node loop if Get_Designated_Entity (Value) = Arch then Spec := Get_Attribute_Specification (Value); Attr_Decl := Get_Named_Entity (Get_Attribute_Designator (Spec)); case Get_Identifier (Attr_Decl) is when Std_Names.Name_Syn_Black_Box => if Get_Type (Attr_Decl) /= Boolean_Type_Definition then Error_Msg_Elab (+Attr_Decl, "type of syn_black_box attribute must be boolean"); return True; end if; Val := Get_Expression (Spec); if Get_Expr_Staticness (Val) /= Locally then -- Do we really require the value to be static if the -- architecture has been elaborated ? Error_Msg_Elab (+Spec, "value of syn_black_box must be static"); return True; end if; if Vhdl.Evaluation.Eval_Pos (Val) /= 0 then return True; end if; when others => null; end case; end if; Value := Get_Value_Chain (Value); end loop; return False; end Is_Arch_Black_Box; function Interning_Get (Param : Inst_Params) return Inst_Object is begin if Is_Arch_Black_Box (Param.Arch) then return Insts_Interning.Get ((Decl => Param.Decl, Arch => Null_Node, Config => Null_Node, Syn_Inst => Param.Syn_Inst, Encoding => Name_Parameters)); else return Insts_Interning.Get (Param); end if; end Interning_Get; 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).Boff; Typ := Typ.Rec.E (Idx + 1).Typ; end; when Iir_Kind_Indexed_Name => declare Voff : Net; Arr_Off : Value_Offsets; begin Synth_Individual_Prefix (Syn_Inst, Inter_Inst, Get_Prefix (Formal), Off, Typ); Synth_Indexed_Name (Syn_Inst, Formal, Typ, Voff, Arr_Off); if Voff /= No_Net then raise Internal_Error; end if; Off := Off + Arr_Off.Net_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 : Value_Offsets; 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, Res_Bnd, Sl_Voff, Sl_Off); if Sl_Voff /= No_Net then raise Internal_Error; end if; Off := Off + Sl_Off.Net_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; Ctxt : constant Context_Acc := Get_Build (Syn_Inst); 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 (Ctxt, V)); end loop; Value_Offset_Tables.Free (Els); -- 3. connect Build (Ctxt, 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; Inter_Typ : Type_Acc) return Net is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); Actual : Node; 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 | Iir_Kind_Association_Element_By_Name => Actual := Get_Actual (Assoc); Act_Inst := Syn_Inst; when Iir_Kind_Association_Element_By_Individual => return Synth_Individual_Input_Assoc (Syn_Inst, Assoc, Inter_Inst); end case; Act := Synth_Expression_With_Type (Act_Inst, Actual, Inter_Typ); Act := Synth_Subtype_Conversion (Ctxt, Act, Inter_Typ, False, Assoc); if Act = No_Valtyp then return No_Net; end if; return Get_Net (Ctxt, 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); Set_Location (Port, Assoc); 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_Kinds_Association_Element_By_Actual => 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); Set_Location (Port, Assoc); 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; procedure Inst_Input_Connect (Syn_Inst : Synth_Instance_Acc; Inst : Instance; Port : in out Port_Idx; Inter_Typ : Type_Acc; N : Net) is begin case Inter_Typ.Kind is when Type_Bit | Type_Logic | Type_Discrete | Type_Float | Type_Vector | Type_Unbounded_Vector | Type_Array | Type_Unbounded_Array => if N /= No_Net then Connect (Get_Input (Inst, Port), N); end if; Port := Port + 1; when Type_Record | Type_Unbounded_Record => for I in Inter_Typ.Rec.E'Range loop if N /= No_Net then Connect (Get_Input (Inst, Port), Build_Extract (Get_Build (Syn_Inst), N, Inter_Typ.Rec.E (I).Boff, Inter_Typ.Rec.E (I).Typ.W)); end if; Port := Port + 1; end loop; when Type_Slice | Type_Access | Type_File | Type_Protected => raise Internal_Error; end case; end Inst_Input_Connect; procedure Inst_Output_Connect (Syn_Inst : Synth_Instance_Acc; Inst : Instance; Idx : in out Port_Idx; Inter_Typ : Type_Acc; N : out Net) is begin case Inter_Typ.Kind is when Type_Bit | Type_Logic | Type_Discrete | Type_Float | Type_Vector | Type_Unbounded_Vector | Type_Array | Type_Unbounded_Array => N := Get_Output (Inst, Idx); Idx := Idx + 1; when Type_Record | Type_Unbounded_Record => declare Nets : Net_Array (1 .. Nat32 (Inter_Typ.Rec.Len)); begin for I in Inter_Typ.Rec.E'Range loop Nets (Nat32 (I)) := Get_Output (Inst, Idx); Idx := Idx + 1; end loop; N := Folds.Build2_Concat (Get_Build (Syn_Inst), Nets); end; when Type_Slice | Type_Access | Type_File | Type_Protected => raise Internal_Error; end case; end Inst_Output_Connect; -- 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; Inter_Typ : Type_Acc; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; N : Net; 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); Inter_Typ := Get_Subtype_Object (Inst_Obj.Syn_Inst, Get_Type (Inter)); case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => -- Connect the net to the input. N := Synth_Input_Assoc (Syn_Inst, Assoc, Inst_Obj.Syn_Inst, Inter, Inter_Typ); Inst_Input_Connect (Syn_Inst, Inst, Nbr_Inputs, Inter_Typ, N); when Port_Out | Port_Inout => Inst_Output_Connect (Syn_Inst, Inst, Nbr_Outputs, Inter_Typ, N); Synth_Output_Assoc (N, Syn_Inst, Assoc, Inst_Obj.Syn_Inst, Inter); end case; end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; if Inst_Obj.Encoding = Name_Parameters then -- Copy values of the generics to module parameters. declare Inter : Node; Vt : Valtyp; 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); if Vt /= No_Valtyp then -- Avoid errors Pv := Memtyp_To_Pval (Get_Memtyp (Vt)); Set_Param_Pval (Inst, Idx, Pv); end if; Inter := Get_Chain (Inter); Idx := Idx + 1; end loop; end; end if; end Synth_Instantiate_Module; procedure Synth_Direct_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node; Sub_Inst : Synth_Instance_Acc; Ent : Node; Arch : Node; Config : Node) is Inst_Obj : Inst_Object; Inst : Instance; Enc : Name_Encoding; begin 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 := Interning_Get ((Decl => Ent, Arch => Arch, Config => Config, Syn_Inst => Sub_Inst, Encoding => Enc)); -- Do the instantiation. 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); Push_Phi; Synth_Instantiate_Module (Syn_Inst, Inst, Inst_Obj, Get_Port_Map_Aspect_Chain (Stmt)); Pop_And_Merge_Phi (Get_Build (Syn_Inst), Get_Location (Stmt)); end Synth_Direct_Instantiation_Statement; procedure Synth_Design_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Sub_Inst : constant Synth_Instance_Acc := Get_Sub_Instance (Syn_Inst, Stmt); Arch : constant Node := Get_Source_Scope (Sub_Inst); Ent : constant Node := Get_Entity (Arch); Config : constant Node := Get_Instance_Config (Sub_Inst); begin Synth_Direct_Instantiation_Statement (Syn_Inst, Stmt, Sub_Inst, Ent, Arch, Config); end Synth_Design_Instantiation_Statement; procedure Synth_Blackbox_Instantiation_Statement (Syn_Inst : Synth_Instance_Acc; Stmt : Node) is Sub_Inst : constant Synth_Instance_Acc := Get_Sub_Instance (Syn_Inst, Stmt); Comp : constant Node := Get_Named_Entity (Get_Instantiated_Unit (Stmt)); begin Synth_Direct_Instantiation_Statement (Syn_Inst, Stmt, Sub_Inst, Comp, Null_Node, Null_Node); end Synth_Blackbox_Instantiation_Statement; procedure Create_Component_Wire (Ctxt : Context_Acc; Inter : Node; Val : Valtyp; Pfx_Name : Sname; Loc : Source.Syn_Src) 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. Set_Value_Wire (Val.Val, Alloc_Wire (Wire_Output, (Inter, Bit_Type))); W := Get_Type_Width (Val.Typ); Value := Build_Signal (Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W); Set_Location (Value, Loc); Set_Wire_Gate (Get_Value_Wire (Val.Val), 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 Ctxt : constant Context_Acc := Get_Build (Syn_Inst); Comp_Inst : constant Synth_Instance_Acc := Get_Sub_Instance (Syn_Inst, Stmt); Config : constant Node := Get_Instance_Config (Comp_Inst); Component : constant Node := Get_Named_Entity (Get_Instantiated_Unit (Stmt)); Bind : constant Node := Get_Binding_Indication (Config); Aspect : constant Node := Get_Entity_Aspect (Bind); 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_Kind (Aspect) = Iir_Kind_Entity_Aspect_Entity); Push_Phi; Inst_Name := New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)); Set_Extra (Comp_Inst, Syn_Inst, Inst_Name); -- 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); Val := Get_Value (Comp_Inst, Inter); Inter_Typ := Val.Typ; case Mode_To_Port_Kind (Get_Mode (Inter)) is when Port_In => N := Synth_Input_Assoc (Syn_Inst, Assoc, Comp_Inst, Inter, Inter_Typ); 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, Assoc); end case; Replace_Signal (Comp_Inst, Assoc_Inter, Val); end if; Next_Association_Interface (Assoc, Assoc_Inter); end loop; end; Sub_Inst := Get_Component_Instance (Comp_Inst); Arch := Get_Source_Scope (Sub_Inst); Ent := Get_Entity (Arch); Sub_Config := Get_Instance_Config (Sub_Inst); if Get_Kind (Ent) = Iir_Kind_Foreign_Module then -- TODO. raise Internal_Error; end if; -- Elaborate generic + map aspect for the entity instance. Set_Extra (Sub_Inst, Comp_Inst, New_Sname_User (Get_Identifier (Ent), No_Sname)); -- 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 := 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); Set_Location (Inst, Stmt); 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 (Ctxt, 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; Pop_And_Merge_Phi (Ctxt, Get_Location (Stmt)); Finalize_Declarations (Comp_Inst, Get_Port_Chain (Component)); 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; when Iir_Kind_Foreign_Module => raise Internal_Error; end case; end if; Next (Dep_It); end loop; end Synth_Dependencies; procedure Synth_Top_Entity (Base : Base_Instance_Acc; Design_Unit : Node; Encoding : Name_Encoding; Syn_Inst : Synth_Instance_Acc) is Lib_Unit : constant Node := Get_Library_Unit (Design_Unit); Arch : Node; Entity : Node; Config : Node; Inst_Obj : Inst_Object; begin -- Extract architecture from design. case Get_Kind (Lib_Unit) is when Iir_Kind_Architecture_Body => Arch := Lib_Unit; Config := Get_Library_Unit (Get_Default_Configuration_Declaration (Arch)); when Iir_Kind_Configuration_Declaration => Config := Lib_Unit; Arch := Get_Named_Entity (Get_Block_Specification (Get_Block_Configuration (Lib_Unit))); when others => raise Internal_Error; end case; Entity := Get_Entity (Arch); Make_Base_Instance (Base); Global_Base_Instance := Base; Insts_Interning.Init; if Flags.Flag_Debug_Init then Elab.Debugger.Debug_Init (Arch); end if; -- Dependencies first. Synth_Dependencies (Root_Instance, Get_Design_Unit (Entity)); Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch)); Set_Extra (Syn_Inst, Base, New_Sname_User (Get_Identifier (Entity), No_Sname)); -- 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)); pragma Unreferenced (Inst_Obj); end Synth_Top_Entity; procedure Create_Input_Wire (Syn_Inst : Synth_Instance_Acc; Self_Inst : Instance; Idx : in out Port_Idx; Val : Valtyp) is N : Net; begin pragma Assert (Val.Val.Kind = Value_Net); N := Get_Value_Net (Val.Val); Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, N); Set_Value_Net (Val.Val, N); end Create_Input_Wire; procedure Create_Output_Wire (Syn_Inst : Synth_Instance_Acc; Self_Inst : Instance; Inter : Node; Idx : in out Port_Idx; Val : Valtyp) is Ctxt : constant Context_Acc := Get_Build (Syn_Inst); 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; Vout : Net; Init : Valtyp; Init_Net : Net; begin pragma Assert (Val.Val.Kind = Value_Wire); -- Create a gate for the output, so that it could be read. Set_Value_Wire (Val.Val, Alloc_Wire (Wire_Output, (Inter, Val.Typ))); -- pragma Assert (Desc.W = Get_Type_Width (Val.Typ)); 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 (Ctxt, Init, Inter_Typ, False, Inter); Init_Net := Get_Net (Ctxt, Init); else Init_Net := No_Net; end if; if Desc.Dir = Port_Inout then declare Io_Inst : Instance; begin if Init_Net /= No_Net then Io_Inst := Builders.Build_Iinout (Ctxt, Val.Typ.W); Connect (Get_Input (Io_Inst, 1), Init_Net); else Io_Inst := Builders.Build_Inout (Ctxt, Val.Typ.W); end if; -- Connect port1 of gate inout to the pin. Vout := 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 Init_Net /= No_Net then Value := Builders.Build_Ioutput (Ctxt, Init_Net); else Value := Builders.Build_Output (Ctxt, Val.Typ.W); end if; Vout := Value; end if; Set_Location (Value, Inter); Set_Wire_Gate (Get_Value_Wire (Val.Val), Value); Inst_Input_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, Vout); end Create_Output_Wire; procedure Synth_Verification_Units (Syn_Inst : Synth_Instance_Acc) is Extra : Synth_Instance_Acc; Unit : Node; begin Extra := Get_First_Extra_Instance (Syn_Inst); while Extra /= null loop Unit := Get_Source_Scope (Extra); Synth_Verification_Unit (Extra, Unit, Syn_Inst); Extra := Get_Next_Extra_Instance (Syn_Inst); 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; if Flag_Verbose then Errors.Info_Msg_Synth (+Entity, "synthesizing %n", (1 => +Entity)); end if; -- Save the current architecture, so that files can be open using a -- path relative to the architecture filename. Elab.Vhdl_Files.Set_Design_Unit (Arch); 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 (Syn_Inst, Self_Inst, Nbr_Inputs, Vt); when Port_Out | Port_Inout => Create_Output_Wire (Syn_Inst, Self_Inst, Inter, Nbr_Outputs, Vt); 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); -- Entity Synth_Concurrent_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_Attribute_Values (Syn_Inst, Entity); end if; -- Architecture if not Is_Error (Syn_Inst) then Synth_Concurrent_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_Attribute_Values (Syn_Inst, Arch); end if; -- Vunits if not Is_Error (Syn_Inst) then Synth_Verification_Units (Syn_Inst); end if; -- Finalize Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); Finalize_Declarations (Syn_Inst, Get_Port_Chain (Entity)); Finalize_Wires; Synthesis.Instance_Passes (Get_Build (Syn_Inst), Inst.M); 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.Vhdl_Insts;