diff options
Diffstat (limited to 'src/synth/synth-vhdl_insts.adb')
| -rw-r--r-- | src/synth/synth-vhdl_insts.adb | 1752 |
1 files changed, 1752 insertions, 0 deletions
diff --git a/src/synth/synth-vhdl_insts.adb b/src/synth/synth-vhdl_insts.adb new file mode 100644 index 000000000..679b63312 --- /dev/null +++ b/src/synth/synth-vhdl_insts.adb @@ -0,0 +1,1752 @@ +-- 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 <gnu.org/licenses>. + +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 Netlists.Folds; + +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Errors; +with Vhdl.Ieee.Math_Real; + +with Synth.Memtype; use Synth.Memtype; +with Synth.Objtypes; use Synth.Objtypes; +with Synth.Values; use Synth.Values; +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.Debugger; +with Synth.Vhdl_Files; +with Synth.Errors; + +package body Synth.Vhdl_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), + 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_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; + + -- 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; + + procedure Copy_Object_Subtype (Syn_Inst : Synth_Instance_Acc; + Inter_Type : Node; + Proto_Inst : Synth_Instance_Acc) + is + Inter_Typ : Type_Acc; + begin + case Get_Kind (Inter_Type) is + when Iir_Kind_Array_Subtype_Definition => + if Synth.Vhdl_Decls.Has_Element_Subtype_Indication (Inter_Type) + then + Copy_Object_Subtype + (Syn_Inst, Get_Element_Subtype (Inter_Type), Proto_Inst); + end if; + when others => + null; + end case; + Inter_Typ := Get_Subtype_Object (Proto_Inst, Inter_Type); + Create_Subtype_Object (Syn_Inst, Inter_Type, Inter_Typ); + end Copy_Object_Subtype; + + procedure Build_Object_Subtype (Syn_Inst : Synth_Instance_Acc; + Inter : Node; + Proto_Inst : Synth_Instance_Acc) is + begin + if Get_Declaration_Type (Inter) /= Null_Node then + Copy_Object_Subtype (Syn_Inst, Get_Type (Inter), Proto_Inst); + end if; + end Build_Object_Subtype; + + -- 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, + Is_Inout => Pkind = Port_Inout, + 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), + Is_Inout => Pkind = Port_Inout, + 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; + Imp : Node; + Syn_Inst : Synth_Instance_Acc; + 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 + 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. + Build_Object_Subtype (Syn_Inst, Inter, Params.Syn_Inst); + + -- Object. + Create_Object (Syn_Inst, Inter, Get_Value (Params.Syn_Inst, Inter)); + 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 + -- Copy the type from PARAMS if needed. The subtype indication of + -- the port may reference objects that aren't anymore reachable + -- (particularly if it is a port of a component). So the subtype + -- cannot be regularly elaborated. + -- Also, for unconstrained subtypes, we need the constraint. + Build_Object_Subtype (Syn_Inst, Inter, Params.Syn_Inst); + 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; + 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 + 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 (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; + + 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).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 => + 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; + + 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_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); + 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; + + 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 Is_Error (Sub_Inst) then + -- TODO: Free it? + return; + end if; + + 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); + + 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 + 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; + 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. + Val.Val.W := 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 (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 + Ctxt : constant Context_Acc := Get_Build (Syn_Inst); + 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); + + Push_Phi; + + 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, 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; + 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 Get_Kind (Ent) = Iir_Kind_Foreign_Module then + -- TODO. + raise Internal_Error; + end if; + + if Arch = Null_Node then + Arch := Libraries.Get_Latest_Architecture (Ent); + else + Arch := Get_Named_Entity (Arch); + end if; + Sub_Config := Get_Library_Unit + (Get_Default_Configuration_Declaration (Arch)); + Sub_Config := Get_Block_Configuration (Sub_Config); + + -- 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); + 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; + 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 (Arch); + 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 (Syn_Inst : Synth_Instance_Acc; + Self_Inst : Instance; + Idx : in out Port_Idx; + Val : Valtyp) is + begin + pragma Assert (Val.Val.Kind = Value_Net); + Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, 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. + Val.Val.W := 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.Is_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 (Val.Val.W, Value); + + Inst_Input_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, Vout); + 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; + + 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. + Synth.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); + 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_Attribute_Values (Syn_Inst, 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_Attribute_Values (Syn_Inst, 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_Declarations (Syn_Inst, Get_Declaration_Chain (Arch)); + Finalize_Declarations (Syn_Inst, Get_Port_Chain (Entity)); + + Finalize_Wires; + + -- 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_Nomemory2 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.Vhdl_Insts; |