path: root/src/synth/synth-insts.adb

--  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 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 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
           | Iir_Inout_Mode =>
            return Port_Out;
         when Iir_Linkage_Mode
           | Iir_Unknown_Mode =>
            raise Synth_Error;
      end case;
   end Mode_To_Port_Kind;

   function Make_Port_Desc (Syn_Inst : Synth_Instance_Acc;
                            Inter : Node) return Port_Desc
   is
      Val : constant Value_Acc := Get_Value (Syn_Inst, Inter);
      Name : Sname;
   begin
      Name :=  New_Sname_User (Get_Identifier (Inter), No_Sname);
      return (Name => Name,
              W => Get_Type_Width (Val.Typ));
   end Make_Port_Desc;

   --  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;
   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_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
           | Value_Instance
           | Value_Subtype =>
            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;
      pragma Assert (GNAT.SHA1.Hash_Length = 20);
      Str : String (1 .. Str_Len + 41);
      Len : Natural;

      Gen_Decl : Node;
      Gen : Value_Acc;
   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.Kind is
                  when Value_Discrete =>
                     declare
                        S : constant String :=
                          Uns64'Image (To_Uns64 (Gen.Scal));
                     begin
                        if Len + S'Length > Str_Len then
                           Has_Hash := True;
                           Hash_Const (Ctxt, Gen, 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, 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 =>
            return New_Sname_User (Id, 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;

   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;
      Cur_Module : Module;
      Val : Value_Acc;
   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);
      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_Object (Syn_Inst, Inter_Type,
                                 Get_Value (Params.Syn_Inst, Inter_Type));
               when others =>
                  null;
            end case;
         end if;

         --  Object.
         Create_Object (Syn_Inst, Inter, Get_Value (Params.Syn_Inst, Inter));
         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
         --  Elaborate the type...
         Synth_Declaration_Type (Syn_Inst, Inter);
         Inter_Typ := Get_Value_Type (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 =>
               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.
      Cur_Module := New_User_Module (Get_Top_Module (Root_Instance),
                                     Create_Module_Name (Params),
                                     Id_User_None, Nbr_Inputs, Nbr_Outputs, 0);

      --  Add ports to module.
      declare
         Inports : Port_Desc_Array (1 .. Nbr_Inputs);
         Outports : Port_Desc_Array (1 .. Nbr_Outputs);
      begin
         Inter := Get_Port_Chain (Decl);
         Nbr_Inputs := 0;
         Nbr_Outputs := 0;
         while Is_Valid (Inter) loop
            case Mode_To_Port_Kind (Get_Mode (Inter)) is
               when Port_In =>
                  Nbr_Inputs := Nbr_Inputs + 1;
                  Inports (Nbr_Inputs) := Make_Port_Desc (Syn_Inst, Inter);
               when Port_Out =>
                  Nbr_Outputs := Nbr_Outputs + 1;
                  Outports (Nbr_Outputs) := Make_Port_Desc (Syn_Inst, 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);
   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_Value_Type (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 : Value_Acc;
   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 : Value_Acc;
      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 : Value_Acc;
   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_Value_Type (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 : Value_Acc;
      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 : Value_Acc;
   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 =>
                  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;
   end Synth_Instantiate_Module;

   procedure Synth_Generics_Association (Sub_Inst : Synth_Instance_Acc;
                                         Syn_Inst : Synth_Instance_Acc;
                                         Inter_Chain : Node;
                                         Assoc_Chain : Node)
   is
      Inter : Node;
      Inter_Type : Type_Acc;
      Assoc : Node;
      Assoc_Inter : Node;
      Actual : Node;
      Val : Value_Acc;
   begin
      Assoc := Assoc_Chain;
      Assoc_Inter := Inter_Chain;
      while Is_Valid (Assoc) loop
         Inter := Get_Association_Interface (Assoc, Assoc_Inter);

         Synth_Declaration_Type (Sub_Inst, Inter);
         Inter_Type := Get_Value_Type (Sub_Inst, Get_Type (Inter));

         pragma Assert (Iir_Parameter_Modes (Get_Mode (Inter)) = Iir_In_Mode);
         case Get_Kind (Assoc) is
            when Iir_Kind_Association_Element_Open =>
               Actual := Get_Default_Value (Inter);
               Val := Synth_Expression_With_Type
                 (Sub_Inst, Actual, Inter_Type);
            when Iir_Kind_Association_Element_By_Expression =>
               Actual := Get_Actual (Assoc);
               Val := Synth_Expression_With_Type
                 (Syn_Inst, Actual, Inter_Type);
            when others =>
               raise Internal_Error;
         end case;

         Val := Synth_Subtype_Conversion (Val, Inter_Type, True, Assoc);

         pragma Assert (Is_Static (Val));

         Create_Object (Sub_Inst, Inter, Val);

         Next_Association_Interface (Assoc, Assoc_Inter);
      end loop;
   end Synth_Generics_Association;

   --  Return the type of EXPR without evaluating it.
   --  FIXME: how dubious is it ?
   function Synth_Type_Of_Object (Syn_Inst : Synth_Instance_Acc; Expr : Node)
                                 return Type_Acc is
   begin
      case Get_Kind (Expr) is
         when Iir_Kind_Signal_Declaration
           | Iir_Kind_Interface_Signal_Declaration =>
            declare
               Val : constant Value_Acc := Get_Value (Syn_Inst, Expr);
            begin
               return Val.Typ;
            end;
         when Iir_Kind_Simple_Name =>
            return Synth_Type_Of_Object (Syn_Inst, Get_Named_Entity (Expr));
         when Iir_Kind_Slice_Name =>
            declare
               Pfx_Typ : Type_Acc;
               Pfx_Bnd : Bound_Type;
               El_Typ : Type_Acc;
               Res_Bnd : Bound_Type;
               Sl_Voff : Net;
               Sl_Off : Uns32;
               Wd : Uns32;
            begin
               Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
               Get_Onedimensional_Array_Bounds (Pfx_Typ, Pfx_Bnd, El_Typ);
               Synth_Slice_Suffix (Syn_Inst, Expr, Pfx_Bnd, El_Typ.W,
                                   Res_Bnd, Sl_Voff, Sl_Off, Wd);

               if Sl_Voff /= No_Net then
                  raise Internal_Error;
               end if;
               return Create_Onedimensional_Array_Subtype (Pfx_Typ, Res_Bnd);
            end;
         when Iir_Kind_Indexed_Name =>
            declare
               Pfx_Typ : Type_Acc;
            begin
               Pfx_Typ := Synth_Type_Of_Object (Syn_Inst, Get_Prefix (Expr));
               return Get_Array_Element (Pfx_Typ);
            end;

         when others =>
            Vhdl.Errors.Error_Kind ("synth_type_of_object", Expr);
      end case;
      return null;
   end Synth_Type_Of_Object;

   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_Value_Type (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 : Value_Acc;
      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 =>
                  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;
   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));

      --  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 => Name_Hash));

      --  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 : Value_Acc; Pfx_Name : Sname)
   is
      Value : Net;
      W : Width;
   begin
      case Val.Kind is
         when Value_Wire =>
            --  Create a gate for the output, so that it could be read.
            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.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_Type : Type_Acc;
         Val : Value_Acc;
         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_Type := 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_Type);
                  when Port_Out =>
                     Val := Create_Value_Wire (No_Wire_Id, Inter_Type);
                     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 : Value_Acc;
         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 =>
                  null;
               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 : Value_Acc;
   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 : Value_Acc;
            Inter_Type : Type_Acc;
         begin
            Inter_Type := Get_Value_Type (Syn_Inst, Get_Type (Inter));
            Val := Synth_Expression_With_Type
              (Syn_Inst, Get_Default_Value (Inter), Inter_Type);
            pragma Assert (Is_Static (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_Value_Type (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 =>
               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);
      Inter_Typ : Type_Acc;
      Value : Net;
      Init : Value_Acc;
      Inp : Input;
      W : Width;
   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);
      W := Get_Output_Desc (Get_Module (Self_Inst), Idx).W;
      pragma Assert (W = Get_Type_Width (Val.Typ));
      if Default /= Null_Node then
         Inter_Typ := Get_Value_Type (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, W);
      end if;
      Set_Location (Value, Inter);
      Inp := Get_Input (Self_Inst, Idx);
      Connect (Inp, Value);
      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;
      Val : Value_Acc;
      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
         Val := Get_Value (Syn_Inst, Inter);
         case Mode_To_Port_Kind (Get_Mode (Inter)) is
            when Port_In =>
               Create_Input_Wire (Self_Inst, Nbr_Inputs, Val);
               Nbr_Inputs := Nbr_Inputs + 1;
            when Port_Out =>
               Create_Output_Wire
                 (Syn_Inst, Self_Inst, Inter, Nbr_Outputs, 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));
      Synth_Concurrent_Statements
        (Syn_Inst, Get_Concurrent_Statement_Chain (Entity));

      Synth_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
      Synth_Concurrent_Statements
        (Syn_Inst, Get_Concurrent_Statement_Chain (Arch));

      Synth_Verification_Units (Syn_Inst, Entity);
      Synth_Verification_Units (Syn_Inst, Arch);

      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;