path: root/src/synth/synth-vhdl_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, see <gnu.org/licenses>.

with GNAT.SHA1;

with Types_Utils; use Types_Utils;
with Name_Table;
with Std_Names;
with Hash; use Hash;
with Dyn_Tables;
with Interning;
with Areapools;
with Synthesis; use Synthesis;

with Grt.Algos;

with Netlists; use Netlists;
with Netlists.Builders; use Netlists.Builders;
with Netlists.Concats;
with Netlists.Folds;

with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes;
with Elab.Vhdl_Values; use Elab.Vhdl_Values;

with Vhdl.Utils; use Vhdl.Utils;
with Vhdl.Errors;
with Vhdl.Evaluation;
with Vhdl.Ieee.Math_Real;
with Vhdl.Std_Package;

with Elab.Memtype; use Elab.Memtype;
with Elab.Vhdl_Files;
with Elab.Debugger;
with Elab.Vhdl_Errors;

with Synth.Vhdl_Environment; use Synth.Vhdl_Environment.Env;
with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts;
with Synth.Vhdl_Decls; use Synth.Vhdl_Decls;
with Synth.Vhdl_Expr; use Synth.Vhdl_Expr;
with Synth.Source; use Synth.Source;
with Synth.Errors;
with Synth.Vhdl_Context; use Synth.Vhdl_Context;

package body Synth.Vhdl_Insts is
   Global_Base_Instance : Base_Instance_Acc;

   function Mode_To_Port_Kind (Mode : Iir_Mode) return Port_Kind is
   begin
      case Mode is
         when Iir_In_Mode =>
            return Port_In;
         when Iir_Buffer_Mode
           | Iir_Out_Mode =>
            return Port_Out;
         when Iir_Inout_Mode =>
            return Port_Inout;
         when Iir_Linkage_Mode
           | Iir_Unknown_Mode =>
            raise Synth_Error;
      end case;
   end Mode_To_Port_Kind;

   --  Parameters that define an instance.
   type Inst_Params is record
      --  Declaration: either the entity or the component.
      Decl : Node;
      --  Implementation: the architecture or Null_Node for black boxes.
      Arch : Node;
      --  Configuration (Null_Node for black boxes).
      Config : Node;
      --  Values of generics.
      Syn_Inst : Synth_Instance_Acc;
      --  Encoding if the instance name.
      Encoding : Name_Encoding;
   end record;

   type Inst_Object is record
      Decl : Node;
      Arch : Node;
      Config : Node;
      Syn_Inst : Synth_Instance_Acc;
      M : Module;
      --  Encoding if the instance name.
      Encoding : Name_Encoding;
   end record;

   function Hash (Params : Inst_Params) return Hash_Value_Type
   is
      Res : Hash_Value_Type;
   begin
      Res := Hash_Value_Type (Params.Decl);
      Res := Res xor Hash_Value_Type (Params.Arch);
      Res := Res xor Hash_Value_Type (Params.Config);
      --  TODO: hash generics
      return Res;
   end Hash;

   function Equal (Obj : Inst_Object; Params : Inst_Params) return Boolean
   is
      Inter : Node;
   begin
      if Obj.Decl /= Params.Decl
        or else Obj.Arch /= Params.Arch
        or else Obj.Config /= Params.Config
      then
         return False;
      end if;
      Inter := Get_Generic_Chain (Params.Decl);
      while Inter /= Null_Node loop
         pragma Assert (Get_Kind (Inter)
                          = Iir_Kind_Interface_Constant_Declaration);
         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
         pragma Assert (Get_Kind (Inter)
                          = Iir_Kind_Interface_Signal_Declaration);
         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.Abound);
         when Type_Array =>
            declare
               T : Type_Acc;
            begin
               T := Typ;
               loop
                  Hash_Bound (C, T.Abound);
                  exit when T.Alast;
                  T := T.Arr_El;
               end loop;
            end;
         when Type_Record =>
            for I in Typ.Rec.E'Range loop
               Hash_Bounds (C, Typ.Rec.E (I).Typ);
            end loop;
         when Type_Bit
           | Type_Logic =>
            null;
         when others =>
            raise Internal_Error;
      end case;
   end Hash_Bounds;

   procedure Hash_Const (C : in out GNAT.SHA1.Context;
                         Val : Value_Acc;
                         Typ : Type_Acc) is
   begin
      case Val.Kind is
         when Value_Memory =>
            Hash_Memory (C, Val.Mem, Typ);
         when Value_Const =>
            Hash_Const (C, Val.C_Val, Typ);
         when Value_Alias =>
            if Val.A_Off /= (0, 0) then
               raise Internal_Error;
            end if;
            Hash_Const (C, Val.A_Obj, Typ);
         when Value_Net
           | Value_Wire
           | Value_Signal
           | Value_File
           | Value_Quantity
           | Value_Terminal
           | Value_Dyn_Alias
           | Value_Sig_Val =>
            raise Internal_Error;
      end case;
   end Hash_Const;

   function Create_Module_Name (Params : Inst_Params) return Sname
   is
      use GNAT.SHA1;
      Decl : constant Node := Params.Decl;
      Id : constant Name_Id := Get_Identifier (Decl);
      Generics : constant Node := Get_Generic_Chain (Decl);
      Ports : constant Node := Get_Port_Chain (Decl);
      Ctxt : GNAT.SHA1.Context;
      Has_Hash : Boolean;

      --  Create a buffer, store the entity name.
      --  For each generic:
      --  * write the value for integers.
      --  * write the identifier for enumerated type with only non-extended
      --    identifiers.
      --  * hash all other values
      --  Append the hash if any.
      use Name_Table;
      Id_Len : constant Natural := Get_Name_Length (Id);
      Str_Len : constant Natural := Id_Len + 512;

      --  True in practice (and used to set the length of STR, but doesn't work
      --  anymore with gcc/gnat 11.
      --  pragma Assert (GNAT.SHA1.Hash_Length = 20);
      Str : String (1 .. Str_Len + 41);
      Len : Natural;

      Gen_Decl : Node;
      Gen : Valtyp;
   begin
      Len := Id_Len;
      Str (1 .. Len) := Get_Name_Ptr (Id) (1 .. Len);

      Has_Hash := False;

      case Params.Encoding is
         when Name_Hash =>
            Ctxt := GNAT.SHA1.Initial_Context;

            Gen_Decl := Generics;
            while Gen_Decl /= Null_Node loop
               if Get_Kind (Gen_Decl) = Iir_Kind_Interface_Constant_Declaration
               then
                  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;
               else
                  --  TODO: add a unique number (index)
                  null;
               end if;
               Gen_Decl := Get_Chain (Gen_Decl);
            end loop;

            declare
               Port_Decl : Node;
               Port_Typ : Type_Acc;
            begin
               Port_Decl := Ports;
               while Port_Decl /= Null_Node loop
                  if not Is_Fully_Constrained_Type (Get_Type (Port_Decl)) then
                     Port_Typ := Get_Value (Params.Syn_Inst, Port_Decl).Typ;
                     Has_Hash := True;
                     Hash_Bounds (Ctxt, Port_Typ);
                  end if;
                  Port_Decl := Get_Chain (Port_Decl);
               end loop;
            end;
            if not Has_Hash and then Generics = Null_Node then
               --  Simple case: same name.
               --  TODO: what about two entities with the same identifier but
               --   declared in two different libraries ?
               --  TODO: what about extended identifiers ?
               return New_Sname_User (Id, No_Sname);
            end if;

            if Has_Hash then
               Str (Len + 1) := '_';
               Len := Len + 1;
               Str (Len + 1 .. Len + 40) := GNAT.SHA1.Digest (Ctxt);
               Len := Len + 40;
            end if;

         when Name_Asis
           | Name_Parameters =>
            return New_Sname_User (Get_Source_Identifier (Decl), No_Sname);

         when Name_Index =>
            --  TODO.
            raise Internal_Error;
      end case;


      return New_Sname_User (Get_Identifier (Str (1 .. Len)), No_Sname);
   end Create_Module_Name;

   --  Create the name of an interface.
   function Get_Encoded_Name_Id (Decl : Node; Enc : Name_Encoding)
                                return Name_Id is
   begin
      case Enc is
         when Name_Asis
           | Name_Parameters =>
            return Get_Source_Identifier (Decl);
         when others =>
            return Get_Identifier (Decl);
      end case;
   end Get_Encoded_Name_Id;

   --  Create the name of an interface.
   function Create_Inter_Name (Decl : Node; Enc : Name_Encoding)
                              return Sname is
   begin
      return New_Sname_User (Get_Encoded_Name_Id (Decl, Enc), No_Sname);
   end Create_Inter_Name;

   --  Return the number of ports for a type.  A record type create one
   --  port per immediate subelement.  Sub-records are not expanded.
   function Count_Nbr_Ports (Typ : Type_Acc) return Port_Nbr is
   begin
      case Typ.Kind is
         when Type_Bit
           | Type_Logic
           | Type_Discrete
           | Type_Float
           | Type_Vector
           | Type_Unbounded_Vector
           | Type_Array
           | Type_Array_Unbounded
           | 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;

   function Get_Type2 (N : Node) return Node
   is
      Res : Node;
   begin
      Res := Get_Type (N);
      if Get_Kind (Res) = Iir_Kind_Interface_Type_Definition then
         Res := Get_Associated_Type (Res);
      end if;
      return Res;
   end Get_Type2;

   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_Array_Unbounded
           | Type_Unbounded_Array =>
            Idx := Idx + 1;
            Descs (Idx) := (Name => Port_Sname,
                            Dir => Pkind,
                            W => Get_Type_Width (Typ));
         when Type_Record
           | Type_Unbounded_Record =>
            declare
               Els : constant Node_Flist := Get_Elements_Declaration_List
                 (Get_Type2 (Inter));
               El : Node;
            begin
               for I in Typ.Rec.E'Range loop
                  El := Get_Nth_Element (Els, Natural (I - 1));
                  Idx := Idx + 1;
                  Descs (Idx) :=
                    (Name => New_Sname_User
                       (Get_Encoded_Name_Id (El, Encoding), Port_Sname),
                     Dir => Pkind,
                     W => Get_Type_Width (Typ.Rec.E (I).Typ));
               end loop;
            end;
         when Type_Slice
           | Type_Access
           | Type_File
           | Type_Protected =>
            raise Internal_Error;
      end case;
   end Build_Ports_Desc;

   function Build (Params : Inst_Params) return Inst_Object
   is
      Decl : constant Node := Params.Decl;
      Arch : constant Node := Params.Arch;
      Inter : Node;
      Inter_Typ : Type_Acc;
      Nbr_Inputs : Port_Nbr;
      Nbr_Outputs : Port_Nbr;
      Nbr_Params : Param_Nbr;
      Cur_Module : Module;
      Val : Valtyp;
      Id : Module_Id;
   begin
      --  Copy values for generics.
      Inter := Get_Generic_Chain (Decl);
      Nbr_Params := 0;
      while Inter /= Null_Node loop
         Nbr_Params := Nbr_Params + 1;
         Inter := Get_Chain (Inter);
      end loop;

      --  Allocate values and count inputs and outputs
      Inter := Get_Port_Chain (Decl);
      Nbr_Inputs := 0;
      Nbr_Outputs := 0;
      Current_Pool := Global_Pool'Access;
      while Is_Valid (Inter) loop
         Inter_Typ := Get_Value (Params.Syn_Inst, Inter).Typ;

         case Mode_To_Port_Kind (Get_Mode (Inter)) is
            when Port_In =>
               Val := Create_Value_Net (No_Net, Inter_Typ);
               Nbr_Inputs := Nbr_Inputs + Count_Nbr_Ports (Inter_Typ);
            when Port_Out
              | Port_Inout =>
               Val := Create_Value_Wire
                 (No_Wire_Id, Inter_Typ, Current_Pool);
               Nbr_Outputs := Nbr_Outputs + Count_Nbr_Ports (Inter_Typ);
         end case;
         Replace_Signal (Params.Syn_Inst, Inter, Val);
         Inter := Get_Chain (Inter);
      end loop;
      Current_Pool := Expr_Pool'Access;

      --  Declare module.
      --  Build it now because it may be referenced for instantiations before
      --  being synthetized.
      if Params.Encoding = Name_Parameters
        and then Nbr_Params > 0
      then
         Id := Id_User_Parameters;
      else
         Id := Id_User_None;
         Nbr_Params := 0;
      end if;
      Cur_Module := New_User_Module (Get_Top_Module (Root_Instance),
                                     Create_Module_Name (Params), Id,
                                     Nbr_Inputs, Nbr_Outputs, Nbr_Params);

      if Id = Id_User_Parameters then
         declare
            Descs : Param_Desc_Array (1 .. Nbr_Params);
            Ptype : Param_Type;
         begin
            Inter := Get_Generic_Chain (Decl);
            Nbr_Params := 0;
            while Inter /= Null_Node loop
               --  Bounds or range of the type.
               Ptype := Type_To_Param_Type (Get_Type (Inter));
               Nbr_Params := Nbr_Params + 1;
               Descs (Nbr_Params) :=
                 (Name => Create_Inter_Name (Inter, Params.Encoding),
                  Typ => Ptype);
               Inter := Get_Chain (Inter);
            end loop;
            Set_Params_Desc (Cur_Module, Descs);
         end;
      end if;

      --  Add ports to module.
      declare
         Inports : Port_Desc_Array (1 .. Nbr_Inputs);
         Outports : Port_Desc_Array (1 .. Nbr_Outputs);
         Pkind : Port_Kind;
         Vt : Valtyp;
      begin
         Inter := Get_Port_Chain (Decl);
         Nbr_Inputs := 0;
         Nbr_Outputs := 0;
         while Is_Valid (Inter) loop
            Pkind := Mode_To_Port_Kind (Get_Mode (Inter));
            Vt := Get_Value (Params.Syn_Inst, Inter);

            case Pkind is
               when Port_In =>
                  Build_Ports_Desc (Inports, Nbr_Inputs,
                                    Pkind, Params.Encoding,
                                    Vt.Typ, Inter);
               when Port_Out
                 | Port_Inout =>
                  Build_Ports_Desc (Outports, Nbr_Outputs,
                                    Pkind, Params.Encoding,
                                    Vt.Typ, Inter);
            end case;
            Inter := Get_Chain (Inter);
         end loop;
         pragma Assert (Nbr_Inputs = Inports'Last);
         pragma Assert (Nbr_Outputs = Outports'Last);
         Set_Ports_Desc (Cur_Module, Inports, Outports);
      end;

      Set_Extra (Params.Syn_Inst, Global_Base_Instance, No_Sname);

      return Inst_Object'(Decl => Decl,
                          Arch => Arch,
                          Config => Params.Config,
                          Syn_Inst => Params.Syn_Inst,
                          M => Cur_Module,
                          Encoding => Params.Encoding);
   end Build;

   package Insts_Interning is new Interning
     (Params_Type => Inst_Params,
      Object_Type => Inst_Object,
      Hash => Hash,
      Build => Build,
      Equal => Equal);

   function Is_Arch_Black_Box (Arch : Node) return Boolean
   is
      use Vhdl.Std_Package;
      use Elab.Vhdl_Errors;
      Value : Node;
      Spec : Node;
      Attr_Decl : Node;
      Val : Node;
   begin
      if Arch = Null_Node then
         return True;
      end if;

      --  A little bit like Find_Attribute_Value, but recoded to handle
      --  many attributes.
      Value := Get_Attribute_Value_Chain (Arch);
      while Value /= Null_Node loop
         if Get_Designated_Entity (Value) = Arch then
            Spec := Get_Attribute_Specification (Value);
            Attr_Decl := Get_Named_Entity (Get_Attribute_Designator (Spec));
            case Get_Identifier (Attr_Decl) is
               when Std_Names.Name_Syn_Black_Box =>
                  if Get_Type (Attr_Decl) /= Boolean_Type_Definition then
                     Error_Msg_Elab
                       (+Attr_Decl,
                        "type of syn_black_box attribute must be boolean");
                     return True;
                  end if;
                  Val := Get_Expression (Spec);
                  if Get_Expr_Staticness (Val) /= Locally then
                     --  Do we really require the value to be static if the
                     --  architecture has been elaborated ?
                     Error_Msg_Elab
                       (+Spec, "value of syn_black_box must be static");
                     return True;
                  end if;
                  if Vhdl.Evaluation.Eval_Pos (Val) /= 0 then
                     return True;
                  end if;
               when others =>
                  null;
            end case;
         end if;
         Value := Get_Value_Chain (Value);
      end loop;
      return False;
   end Is_Arch_Black_Box;

   function Interning_Get (Param : Inst_Params) return Inst_Object is
   begin
      if Is_Arch_Black_Box (Param.Arch) then
         return Insts_Interning.Get ((Decl => Param.Decl,
                                      Arch => Null_Node,
                                      Config => Null_Node,
                                      Syn_Inst => Param.Syn_Inst,
                                      Encoding => Name_Parameters));
      else
         return Insts_Interning.Get (Param);
      end if;
   end Interning_Get;

   function Synth_Single_Input_Assoc (Syn_Inst : Synth_Instance_Acc;
                                      Inter_Typ : Type_Acc;
                                      Act_Inst : Synth_Instance_Acc;
                                      Actual : Node;
                                      Assoc : Node) return Valtyp
   is
      Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
      Conv : Node;
      Act : Valtyp;
   begin
      if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Name then
         Conv := Get_Actual_Conversion (Assoc);
      else
         Conv := Null_Node;
      end if;
      if Conv /= Null_Node then
         case Get_Kind (Conv) is
            when Iir_Kind_Function_Call =>
               pragma Assert (Act_Inst = Syn_Inst);
               --  This is an abuse, but it works like a user operator.
               Act := Synth_User_Operator (Syn_Inst, Actual, Null_Node, Conv);
            when Iir_Kind_Type_Conversion =>
               Act := Synth_Type_Conversion (Syn_Inst, Conv);
            when others =>
               Vhdl.Errors.Error_Kind ("synth_single_input_assoc", Conv);
         end case;
      elsif Actual = Null_Node then
         --  No actual, no default value.
         Act := Create_Value_Net
           (Build_Const_X (Ctxt, Inter_Typ.W), Inter_Typ);
      else
         Act := Synth_Expression_With_Type (Act_Inst, Actual, Inter_Typ);
      end if;

      Act := Synth_Subtype_Conversion (Act_Inst, Act, Inter_Typ, False, Assoc);
      return Act;
   end Synth_Single_Input_Assoc;

   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;
      Typ : Type_Acc;
      Els : Value_Offset_Tables.Instance;
      Concat : Concat_Type;
      N_Off : Uns32;
      N : Net;
      Base : Valtyp;
      Offs : Value_Offsets;
      Dyn : Dyn_Name;
   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_Assignment_Prefix
           (Syn_Inst, Inter_Inst, Get_Formal (Iassoc), Base, Typ, Offs, Dyn);
         pragma Assert (Dyn = No_Dyn_Name);

         --   2. synth expression
         V := Synth_Single_Input_Assoc
           (Syn_Inst, Typ, Syn_Inst, Get_Actual (Iassoc), Iassoc);

         --   3. save in a table
         Value_Offset_Tables.Append (Els, (Offs.Net_Off, V));

         Iassoc := Get_Chain (Iassoc);
      end loop;

      pragma Unreferenced (Base);

      --  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);
      Marker : Mark_Type;
      Res : Valtyp;
      Res_Net : Net;
   begin
      Mark_Expr_Pool (Marker);
      case Iir_Kinds_Association_Element_Parameters (Get_Kind (Assoc)) is
         when Iir_Kind_Association_Element_Open =>
            Res := Synth_Single_Input_Assoc
              (Syn_Inst, Inter_Typ, Inter_Inst,
               Get_Default_Value (Inter), Assoc);
         when Iir_Kind_Association_Element_By_Expression
            | Iir_Kind_Association_Element_By_Name =>
            Res := Synth_Single_Input_Assoc
              (Syn_Inst, Inter_Typ, Syn_Inst, Get_Actual (Assoc), Assoc);
         when Iir_Kind_Association_Element_By_Individual =>
            Res_Net := Synth_Individual_Input_Assoc
              (Syn_Inst, Assoc, Inter_Inst);
            Release_Expr_Pool (Marker);
            return Res_Net;
      end case;

      if Res = No_Valtyp then
         return No_Net;
      end if;
      Res_Net := Get_Net (Ctxt, Res);
      Release_Expr_Pool (Marker);

      return Res_Net;
   end Synth_Input_Assoc;

   procedure Synth_Individual_Output_Assoc (Outp : Net;
                                            Syn_Inst : Synth_Instance_Acc;
                                            Assoc : Node;
                                            Inter_Inst : Synth_Instance_Acc)
   is
      Marker : Mark_Type;
      Iassoc : Node;
      V : Valtyp;
      Typ : Type_Acc;
      O : Net;
      Port : Net;
      Base : Valtyp;
      Dyn : Dyn_Name;
      Offs : Value_Offsets;
   begin
      Mark_Expr_Pool (Marker);

      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_Assignment_Prefix
           (Syn_Inst, Inter_Inst, Get_Formal (Iassoc), Base, Typ, Offs, Dyn);
         pragma Assert (Dyn = No_Dyn_Name);

         --   2. Extract the value.
         O := Build_Extract (Get_Build (Syn_Inst), Port, Offs.Net_Off, Typ.W);
         V := Create_Value_Net (O, Typ);

         --   3. Assign.
         Synth_Assignment (Syn_Inst, Get_Actual (Iassoc), V, Iassoc);

         Release_Expr_Pool (Marker);

         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
      Marker : Mark_Type;
      Actual : Node;
      Formal_Typ : Type_Acc;
      Port : Net;
      O : Valtyp;
   begin
      case Get_Kind (Assoc) is
         when Iir_Kind_Association_Element_Open =>
            --  Not connected.
            return;
         when Iir_Kinds_Association_Element_By_Actual =>
            Actual := Get_Actual (Assoc);
         when others =>
            Synth_Individual_Output_Assoc
              (Outp, Syn_Inst, Assoc, Inter_Inst);
            return;
      end case;

      Formal_Typ := Get_Value (Inter_Inst, Inter).Typ;

      Mark_Expr_Pool (Marker);
      --  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);
      Release_Expr_Pool (Marker);
   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_Array_Unbounded
           | 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).Offs.Net_Off,
                                          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_Array_Unbounded
           | 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_Ports (Syn_Inst : Synth_Instance_Acc;
                                             Inst : Instance;
                                             Ent_Inst : Synth_Instance_Acc;
                                             Ent : Node;
                                             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)
      Marker : Mark_Type;

      Assoc : Node;
      Assoc_Inter : Node;
      Inter : Node;
      Inter_Typ : Type_Acc;
      Nbr_Inputs : Port_Nbr;
      Nbr_Outputs : Port_Nbr;
      N : Net;
   begin
      Mark_Expr_Pool (Marker);

      Assoc := Ports_Assoc;
      Assoc_Inter := Get_Port_Chain (Ent);
      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 (Ent_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, Ent_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, Ent_Inst, Inter);

            end case;
            pragma Assert (Areapools.Is_At_Mark (Expr_Pool, Marker));
         end if;
         Next_Association_Interface (Assoc, Assoc_Inter);
      end loop;
   end Synth_Instantiate_Module_Ports;

   procedure Synth_Instantiate_Module_Generics (Inst : Instance;
                                                Inst_Obj : Inst_Object) is
   begin
      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_Generics;

   procedure Synth_Direct_Instantiation_Statement
     (Syn_Inst : Synth_Instance_Acc;
      Stmt : Node;
      Sub_Inst : Synth_Instance_Acc;
      Ent : Node;
      Arch : Node;
      Config : Node)
   is
      Inst_Obj : Inst_Object;
      Inst : Instance;
      Enc : Name_Encoding;
   begin
      if Arch /= Null_Node then
         --  For whiteboxes: append parameters or/and hash.
         Enc := Name_Hash;
      else
         --  For blackboxes: define the parameters.
         Enc := Name_Parameters;
      end if;

      --  Search if corresponding module has already been used.
      --  If not create a new module
      --   * create a name from the generics and the library
      --   * create inputs/outputs
      --   * add it to the list of module to be synthesized.
      Inst_Obj := Interning_Get ((Decl => Ent,
                                  Arch => Arch,
                                  Config => Config,
                                  Syn_Inst => Sub_Inst,
                                  Encoding => Enc));

      pragma Assert (Is_Expr_Pool_Empty);

      --  Do the instantiation.
      Inst := New_Instance
        (Get_Instance_Module (Syn_Inst),
         Inst_Obj.M,
         New_Sname_User (Get_Identifier (Stmt), Get_Sname (Syn_Inst)));
      Set_Location (Inst, Stmt);

      pragma Assert (Is_Expr_Pool_Empty);

      Push_Phi;

      Synth_Instantiate_Module_Ports
        (Syn_Inst, Inst, Inst_Obj.Syn_Inst, Inst_Obj.Decl,
         Get_Port_Map_Aspect_Chain (Stmt));
      pragma Assert (Is_Expr_Pool_Empty);

      Synth_Instantiate_Module_Generics (Inst, Inst_Obj);
      pragma Assert (Is_Expr_Pool_Empty);

      Pop_And_Merge_Phi (Get_Build (Syn_Inst), Get_Location (Stmt));

      pragma Assert (Is_Expr_Pool_Empty);
   end Synth_Direct_Instantiation_Statement;

   procedure Synth_Design_Instantiation_Statement
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Sub_Inst : constant Synth_Instance_Acc :=
        Get_Sub_Instance (Syn_Inst, Stmt);
      Arch : constant Node := Get_Source_Scope (Sub_Inst);
      Ent : constant Node := Get_Entity (Arch);
      Config : constant Node := Get_Instance_Config (Sub_Inst);
   begin
      Synth_Direct_Instantiation_Statement
        (Syn_Inst, Stmt, Sub_Inst, Ent, Arch, Config);
   end Synth_Design_Instantiation_Statement;

   procedure Synth_Blackbox_Instantiation_Statement
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Sub_Inst : constant Synth_Instance_Acc :=
        Get_Sub_Instance (Syn_Inst, Stmt);
      Comp : constant Node :=
        Get_Named_Entity (Get_Instantiated_Unit (Stmt));
   begin
      Synth_Direct_Instantiation_Statement
        (Syn_Inst, Stmt, Sub_Inst, Comp, Null_Node, Null_Node);
   end Synth_Blackbox_Instantiation_Statement;

   procedure Create_Component_Wire (Ctxt : Context_Acc;
                                    Inter : Node;
                                    Val : Valtyp;
                                    Pfx_Name : Sname;
                                    Loc : Source.Syn_Src)
   is
      Value : Net;
      W : Width;
   begin
      case Val.Val.Kind is
         when Value_Wire =>
            --  Create a gate for the output, so that it could be read.
            Set_Value_Wire
              (Val.Val, Alloc_Wire (Wire_Output, (Inter, Bit_Type)));
            W := Get_Type_Width (Val.Typ);
            Value := Build_Signal
              (Ctxt, New_Internal_Name (Ctxt, Pfx_Name), W);
            Set_Location (Value, Loc);
            Set_Wire_Gate (Get_Value_Wire (Val.Val), Value);
         when others =>
            raise Internal_Error;
      end case;
   end Create_Component_Wire;

   procedure Synth_Component_Instantiation_Statement
     (Syn_Inst : Synth_Instance_Acc; Stmt : Node)
   is
      Ctxt : constant Context_Acc := Get_Build (Syn_Inst);
      Comp_Inst : constant Synth_Instance_Acc :=
        Get_Sub_Instance (Syn_Inst, Stmt);
      Config : constant Node := Get_Instance_Config (Comp_Inst);
      Component : constant Node :=
        Get_Named_Entity (Get_Instantiated_Unit (Stmt));
      Bind : constant Node := Get_Binding_Indication (Config);
      Aspect : constant Node := Get_Entity_Aspect (Bind);

      Marker : Mark_Type;
      Ent : Node;
      Arch : Node;
      Sub_Config : Node;
      Sub_Inst : Synth_Instance_Acc;
      Inst_Obj : Inst_Object;
      Inst : Instance;
      Inst_Name : Sname;

      M : Module;
   begin
      Mark_Expr_Pool (Marker);
      pragma Assert (Is_Expr_Pool_Empty);
      pragma Assert (Get_Kind (Aspect) = Iir_Kind_Entity_Aspect_Entity);

      Push_Phi;

      Inst_Name := New_Sname_User (Get_Identifier (Stmt),
                                   Get_Sname (Syn_Inst));

      Set_Extra (Comp_Inst, Syn_Inst, Inst_Name);

      --  Create objects for the inputs and the outputs of the component,
      --  assign inputs (that's nets) and create wires for outputs.
      declare
         Assoc : Node;
         Assoc_Inter : Node;
         Inter : Node;
         Inter_Typ : Type_Acc;
         Val : Valtyp;
         N : Net;
      begin
         Assoc := Get_Port_Map_Aspect_Chain (Stmt);
         Assoc_Inter := Get_Port_Chain (Component);
         while Is_Valid (Assoc) loop
            if Get_Whole_Association_Flag (Assoc) then
               Inter := Get_Association_Interface (Assoc, Assoc_Inter);
               Val := Get_Value (Comp_Inst, Inter);
               Inter_Typ := Val.Typ;

               case Mode_To_Port_Kind (Get_Mode (Inter)) is
                  when Port_In =>
                     N := Synth_Input_Assoc
                       (Syn_Inst, Assoc, Comp_Inst, Inter, Inter_Typ);
                     Val := Create_Value_Net (N, Inter_Typ);
                  when Port_Out
                    | Port_Inout =>
                     Val := Create_Value_Wire
                       (No_Wire_Id, Inter_Typ, Instance_Pool);
                     Create_Component_Wire
                       (Get_Build (Syn_Inst), Assoc_Inter, Val, Inst_Name,
                        Assoc);
               end case;
               Replace_Signal (Comp_Inst, Assoc_Inter, Val);
            end if;
            Next_Association_Interface (Assoc, Assoc_Inter);
         end loop;
      end;

      Sub_Inst := Get_Component_Instance (Comp_Inst);
      Arch := Get_Source_Scope (Sub_Inst);
      Sub_Config := Get_Instance_Config (Sub_Inst);
      if Get_Kind (Arch) = Iir_Kind_Foreign_Module then
         M := Synth_Foreign_Module
           (Global_Base_Instance, Get_Instance_Foreign (Sub_Inst),
            Sub_Inst, Arch);

         Inst := New_Instance (Get_Instance_Module (Syn_Inst), M, Inst_Name);
         Set_Location (Inst, Stmt);

         Synth_Instantiate_Module_Ports
           (Comp_Inst, Inst, Sub_Inst, Arch,
            Get_Port_Map_Aspect_Chain (Bind));
      else
         Ent := Get_Entity (Arch);

         --  Elaborate generic + map aspect for the entity instance.
         Set_Extra (Sub_Inst, Comp_Inst,
                    New_Sname_User (Get_Identifier (Ent), No_Sname));

         --  Search if corresponding module has already been used.
         --  If not create a new module
         --   * create a name from the generics and the library
         --   * create inputs/outputs
         --   * add it to the list of module to be synthesized.
         Inst_Obj := Interning_Get ((Decl => Ent,
                                     Arch => Arch,
                                     Config => Sub_Config,
                                     Syn_Inst => Sub_Inst,
                                     Encoding => Name_Hash));

         --  TODO: free sub_inst.

         Inst := New_Instance (Get_Instance_Module (Syn_Inst),
                               Inst_Obj.M, Inst_Name);
         Set_Location (Inst, Stmt);

         Synth_Instantiate_Module_Ports
           (Comp_Inst, Inst, Inst_Obj.Syn_Inst, Inst_Obj.Decl,
            Get_Port_Map_Aspect_Chain (Bind));
         Synth_Instantiate_Module_Generics (Inst, Inst_Obj);
      end if;

      pragma Unreferenced (M);

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

      Release_Expr_Pool (Marker);
   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_Concurrent_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_Concurrent_Package_Body
                          (Parent_Inst, Dep_Unit, Bod);
                     end if;
                  end;
               when Iir_Kind_Package_Instantiation_Declaration =>
                  Synth_Concurrent_Package_Instantiation
                    (Parent_Inst, Dep_Unit);
               when Iir_Kind_Package_Body =>
                  null;
               when Iir_Kind_Architecture_Body =>
                  null;
               when Iir_Kinds_Verification_Unit =>
                  null;
               when Iir_Kind_Foreign_Module =>
                  raise Internal_Error;
            end case;
         end if;
         Next (Dep_It);
      end loop;
   end Synth_Dependencies;

   procedure Synth_Top_Entity (Base : Base_Instance_Acc;
                               Design_Unit : Node;
                               Encoding : Name_Encoding;
                               Syn_Inst : Synth_Instance_Acc)
   is
      Lib_Unit : constant Node := Get_Library_Unit (Design_Unit);
      Arch : Node;
      Entity : Node;
      Config : Node;
      Inst_Obj : Inst_Object;
   begin
      --  Extract architecture from design.
      case Get_Kind (Lib_Unit) is
         when Iir_Kind_Architecture_Body =>
            Arch := Lib_Unit;
            Config := Get_Library_Unit
              (Get_Default_Configuration_Declaration (Arch));
         when Iir_Kind_Configuration_Declaration =>
            Config := Lib_Unit;
            Arch := Get_Named_Entity
              (Get_Block_Specification (Get_Block_Configuration (Lib_Unit)));
         when others =>
            raise Internal_Error;
      end case;
      Entity := Get_Entity (Arch);

      Make_Base_Instance (Base);

      Global_Base_Instance := Base;

      Insts_Interning.Init;

      if Flags.Flag_Debug_Init then
         Elab.Debugger.Debug_Init (Arch);
      end if;

      pragma Assert (Is_Expr_Pool_Empty);

      --  Dependencies first.
      Synth_Dependencies (Root_Instance, Get_Design_Unit (Entity));
      Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch));

      Set_Extra
        (Syn_Inst, Base, New_Sname_User (Get_Identifier (Entity), No_Sname));

      --  Search if corresponding module has already been used.
      --  If not create a new module
      --   * create a name from the generics and the library
      --   * create inputs/outputs
      --   * add it to the list of module to be synthesized.
      Inst_Obj := Insts_Interning.Get
        ((Decl => Entity,
          Arch => Arch,
          Config => Get_Block_Configuration (Config),
          Syn_Inst => Syn_Inst,
          Encoding => Encoding));
      pragma Unreferenced (Inst_Obj);

      pragma Assert (Is_Expr_Pool_Empty);
   end Synth_Top_Entity;

   procedure Create_Input_Wire (Syn_Inst : Synth_Instance_Acc;
                                Self_Inst : Instance;
                                Idx : in out Port_Idx;
                                Val : Valtyp)
   is
      N : Net;
   begin
      pragma Assert (Val.Val.Kind = Value_Net);
      N := Get_Value_Net (Val.Val);
      Inst_Output_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, N);
      Set_Value_Net (Val.Val, N);
   end Create_Input_Wire;

   procedure Create_Output_Wire (Syn_Inst : Synth_Instance_Acc;
                                 Self_Inst : Instance;
                                 Inter : Node;
                                 Idx : in out Port_Idx;
                                 Val : Valtyp)
   is
      Ctxt      : constant Context_Acc := Get_Build (Syn_Inst);
      Default   : constant Node := Get_Default_Value (Inter);
      Desc      : constant Port_Desc :=
        Get_Output_Desc (Get_Module (Self_Inst), Idx);
      Marker : Mark_Type;
      Inter_Typ : Type_Acc;
      Value     : Net;
      Vout      : Net;
      Init      : Valtyp;
      Init_Net  : Net;
   begin
      pragma Assert (Val.Val.Kind = Value_Wire);

      --  Create a gate for the output, so that it could be read.
      Set_Value_Wire (Val.Val, Alloc_Wire (Wire_Output, (Inter, Val.Typ)));
      --  pragma Assert (Desc.W = Get_Type_Width (Val.Typ));

      if Default /= Null_Node then
         Mark_Expr_Pool (Marker);
         Inter_Typ := Get_Subtype_Object (Syn_Inst, Get_Type (Inter));
         Init := Synth_Expression_With_Type (Syn_Inst, Default, Inter_Typ);
         Init := Synth_Subtype_Conversion
           (Syn_Inst, Init, Inter_Typ, False, Inter);
         Init_Net := Get_Net (Ctxt, Init);
         Release_Expr_Pool (Marker);
      else
         Init_Net := No_Net;
      end if;

      if Desc.Dir = Port_Inout then
         declare
            Io_Inst : Instance;
         begin
            if Init_Net /= No_Net then
               Io_Inst := Builders.Build_Iinout (Ctxt, Val.Typ.W);
               Connect (Get_Input (Io_Inst, 1), Init_Net);
            else
               Io_Inst := Builders.Build_Inout (Ctxt, Val.Typ.W);
            end if;
            --  Connect port1 of gate inout to the pin.
            Vout := Get_Output (Io_Inst, 1);
            --  And port0 of the gate will be use to read from the pin.
            Value := Get_Output (Io_Inst, 0);
         end;
      else
         if Init_Net /= No_Net then
            Value := Builders.Build_Ioutput (Ctxt, Init_Net);
         else
            Value := Builders.Build_Output (Ctxt, Val.Typ.W);
         end if;
         Vout := Value;
      end if;
      Set_Location (Value, Inter);
      Set_Wire_Gate (Get_Value_Wire (Val.Val), Value);

      Inst_Input_Connect (Syn_Inst, Self_Inst, Idx, Val.Typ, Vout);
   end Create_Output_Wire;

   procedure Synth_Verification_Units (Syn_Inst : Synth_Instance_Acc)
   is
      Extra : Synth_Instance_Acc;
      Unit : Node;
   begin
      Extra := Get_First_Extra_Instance (Syn_Inst);
      while Extra /= null loop
         Unit := Get_Source_Scope (Extra);
         Synth_Verification_Unit (Extra, Unit, Syn_Inst);
         Extra := Get_Next_Extra_Instance (Syn_Inst);
      end loop;
   end Synth_Verification_Units;

   procedure Synth_Instance (Inst : Inst_Object)
   is
      Entity : constant Node := Inst.Decl;
      Arch : constant Node := Inst.Arch;
      Syn_Inst : constant Synth_Instance_Acc := Inst.Syn_Inst;
      Marker : Mark_Type;
      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;

      pragma Assert (Is_Expr_Pool_Empty);

      --  Save the current architecture, so that files can be open using a
      --  path relative to the architecture filename.
      Elab.Vhdl_Files.Set_Design_Unit (Arch);

      Synth_Dependencies (Root_Instance, Get_Design_Unit (Arch));

      Set_Instance_Module (Syn_Inst, Inst.M);
      Self_Inst := Get_Self_Instance (Inst.M);
      Set_Location (Self_Inst, Entity);

      pragma Assert (Is_Expr_Pool_Empty);

      Areapools.Mark (Marker, Process_Pool);
      Instance_Pool := Process_Pool'Access;

      --  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;
         pragma Assert (Is_Expr_Pool_Empty);
         Inter := Get_Chain (Inter);
      end loop;

      --  Apply configuration.
      --  FIXME: what about inner block configuration ?
      pragma Assert (Get_Kind (Inst.Config) = Iir_Kind_Block_Configuration);

      --  Entity
      Synth_Concurrent_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
      if not Is_Error (Syn_Inst) then
         Synth_Concurrent_Statements
           (Syn_Inst, Get_Concurrent_Statement_Chain (Entity));
      end if;

      pragma Assert (Is_Expr_Pool_Empty);

      if not Is_Error (Syn_Inst) then
         Synth_Attribute_Values (Syn_Inst, Entity);
      end if;

      pragma Assert (Is_Expr_Pool_Empty);

      --  Architecture
      if not Is_Error (Syn_Inst) then
         Synth_Concurrent_Declarations
           (Syn_Inst, Get_Declaration_Chain (Arch));
      end if;

      pragma Assert (Is_Expr_Pool_Empty);

      if not Is_Error (Syn_Inst) then
         Synth_Concurrent_Statements
           (Syn_Inst, Get_Concurrent_Statement_Chain (Arch));
      end if;

      pragma Assert (Is_Expr_Pool_Empty);

      if not Is_Error (Syn_Inst) then
         Synth_Attribute_Values (Syn_Inst, Arch);
      end if;

      pragma Assert (Is_Expr_Pool_Empty);

      --  Vunits
      if not Is_Error (Syn_Inst) then
         Synth_Verification_Units (Syn_Inst);
      end if;

      pragma Assert (Is_Expr_Pool_Empty);

      --  Finalize
      Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Arch));
      Finalize_Declarations (Syn_Inst, Get_Declaration_Chain (Entity));
      Finalize_Declarations (Syn_Inst, Get_Port_Chain (Entity));

      Finalize_Wires;

      Areapools.Release (Marker, Process_Pool);

      Synthesis.Instance_Passes (Get_Build (Syn_Inst), Inst.M);

      pragma Assert (Is_Expr_Pool_Empty);
   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;