--  Iir to ortho translator.
--  Copyright (C) 2002, 2003, 2004, 2005, 2006 Tristan Gingold
--
--  GHDL 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, or (at your option) any later
--  version.
--
--  GHDL 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 GCC; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.
with System;
with Ada.Unchecked_Deallocation;
with Interfaces; use Interfaces;
with Ortho_Nodes; use Ortho_Nodes;
with Ortho_Ident; use Ortho_Ident;
with Evaluation; use Evaluation;
with Flags; use Flags;
with Ada.Text_IO;
with Types; use Types;
with Errorout; use Errorout;
with Name_Table; -- use Name_Table;
with Iirs_Utils; use Iirs_Utils;
with Std_Package; use Std_Package;
with Libraries;
with Files_Map;
with Std_Names;
with Configuration;
with Interfaces.C_Streams;
with Sem_Names;
with Sem;
with Iir_Chains; use Iir_Chains;
with Nodes;
with GNAT.Table;
with Ieee.Std_Logic_1164;
with Canon;
with Canon_PSL;
with PSL.Nodes;
with PSL.NFAs;
with PSL.NFAs.Utils;
with Trans_Decls; use Trans_Decls;
with Trans_Analyzes;

package body Translation is

   --  Ortho type node for STD.BOOLEAN.
   Std_Boolean_Type_Node : O_Tnode;
   Std_Boolean_True_Node : O_Cnode;
   Std_Boolean_False_Node : O_Cnode;
   --  Array of STD.BOOLEAN.
   Std_Boolean_Array_Type : O_Tnode;
   --  Std_ulogic indexed array of STD.Boolean.
   Std_Ulogic_Boolean_Array_Type : O_Tnode;
   --  Ortho type node for string template pointer.
   Std_String_Ptr_Node : O_Tnode;
   Std_String_Node : O_Tnode;

   --  Ortho type for std.integer.
   Std_Integer_Type_Node : O_Tnode;

   --  Ortho type for std.real.
   Std_Real_Type_Node : O_Tnode;

   --  Ortho type node for std.time.
   Std_Time_Type : O_Tnode;

   --  Ortho type for std.file_open_status.
   Std_File_Open_Status_Type : O_Tnode;

   --  Node for the variable containing the current filename.
   Current_Filename_Node : O_Dnode := O_Dnode_Null;
   Current_Library_Unit : Iir := Null_Iir;

   --  Global declarations.
   Ghdl_Ptr_Type : O_Tnode;
   Sizetype : O_Tnode;
   Ghdl_I32_Type : O_Tnode;
   Ghdl_I64_Type : O_Tnode;
   Ghdl_Real_Type : O_Tnode;
   --  Constant character.
   Char_Type_Node : O_Tnode;
   --  Array of char.
   Chararray_Type : O_Tnode;
   --  Pointer to array of char.
   Char_Ptr_Type : O_Tnode;
   --  Array of char ptr.
   Char_Ptr_Array_Type : O_Tnode;
   Char_Ptr_Array_Ptr_Type : O_Tnode;

   Ghdl_Index_Type : O_Tnode;
   Ghdl_Index_0 : O_Cnode;
   Ghdl_Index_1 : O_Cnode;

   --  Type for a file (this is in fact a index in a private table).
   Ghdl_File_Index_Type : O_Tnode;
   Ghdl_File_Index_Ptr_Type : O_Tnode;

   --  Record containing a len and string fields.
   Ghdl_Str_Len_Type_Node : O_Tnode;
   Ghdl_Str_Len_Type_Len_Field : O_Fnode;
   Ghdl_Str_Len_Type_Str_Field : O_Fnode;
   Ghdl_Str_Len_Ptr_Node : O_Tnode;
   Ghdl_Str_Len_Array_Type_Node : O_Tnode;

   --  Location.
   Ghdl_Location_Type_Node : O_Tnode;
   Ghdl_Location_Filename_Node : O_Fnode;
   Ghdl_Location_Line_Node : O_Fnode;
   Ghdl_Location_Col_Node : O_Fnode;
   Ghdl_Location_Ptr_Node : O_Tnode;

   --  Allocate memory for a block.
   Ghdl_Alloc_Ptr : O_Dnode;

   --  bool type.
   Ghdl_Bool_Type : O_Tnode;
   type Enode_Boolean_Array is array (Boolean) of O_Cnode;
   Ghdl_Bool_Nodes : Enode_Boolean_Array;
   Ghdl_Bool_False_Node : O_Cnode renames Ghdl_Bool_Nodes (False);
   Ghdl_Bool_True_Node : O_Cnode renames Ghdl_Bool_Nodes (True);

   Ghdl_Bool_Array_Type : O_Tnode;
   Ghdl_Bool_Array_Ptr : O_Tnode;

   --  Comparaison type.
   Ghdl_Compare_Type : O_Tnode;
   Ghdl_Compare_Lt : O_Cnode;
   Ghdl_Compare_Eq : O_Cnode;
   Ghdl_Compare_Gt : O_Cnode;

   --  Dir type.
   Ghdl_Dir_Type_Node : O_Tnode;
   Ghdl_Dir_To_Node : O_Cnode;
   Ghdl_Dir_Downto_Node : O_Cnode;

   --  Signals.
   Ghdl_Scalar_Bytes : O_Tnode;
   Ghdl_Signal_Type : O_Tnode;
   Ghdl_Signal_Value_Field : O_Fnode;
   Ghdl_Signal_Driving_Value_Field : O_Fnode;
   Ghdl_Signal_Last_Value_Field : O_Fnode;
   Ghdl_Signal_Last_Event_Field : O_Fnode;
   Ghdl_Signal_Last_Active_Field : O_Fnode;
   Ghdl_Signal_Event_Field : O_Fnode;
   Ghdl_Signal_Active_Field : O_Fnode;
   Ghdl_Signal_Has_Active_Field : O_Fnode;

   Ghdl_Signal_Ptr : O_Tnode;
   Ghdl_Signal_Ptr_Ptr : O_Tnode;

   type Object_Kind_Type is (Mode_Value, Mode_Signal);

   --  Well known identifiers.
   Wki_This : O_Ident;
   Wki_Size : O_Ident;
   Wki_Res : O_Ident;
   Wki_Dir_To : O_Ident;
   Wki_Dir_Downto : O_Ident;
   Wki_Left : O_Ident;
   Wki_Right : O_Ident;
   Wki_Dir : O_Ident;
   Wki_Length : O_Ident;
   Wki_I : O_Ident;
   Wki_Instance : O_Ident;
   Wki_Arch_Instance : O_Ident;
   Wki_Name : O_Ident;
   Wki_Sig : O_Ident;
   Wki_Obj : O_Ident;
   Wki_Rti : O_Ident;
   Wki_Parent : O_Ident;
   Wki_Filename : O_Ident;
   Wki_Line : O_Ident;
   Wki_Lo : O_Ident;
   Wki_Hi : O_Ident;
   Wki_Mid : O_Ident;
   Wki_Cmp : O_Ident;
   Wki_Upframe : O_Ident;
   Wki_Frame : O_Ident;

   --  ALLOCATION_KIND defines the type of memory storage.
   --  ALLOC_STACK means the object is allocated on the local stack and
   --    deallocated at the end of the function.
   --  ALLOC_SYSTEM for object created during design elaboration and whose
   --    life is infinite.
   --  ALLOC_RETURN for unconstrained object returns by function.
   --  ALLOC_HEAP for object created by new.
   type Allocation_Kind is
     (Alloc_Stack, Alloc_Return, Alloc_Heap, Alloc_System);

   package Chap10 is
      --  There are three data storage kind: global, local or instance.
      --  For example, a constant can have:
      --  * a global storage when declared inside a package.  This storage
      --    can be accessed from any point.
      --  * a local storage when declared in a subprogram.  This storage
      --    can be accessed from the subprogram, is created when the subprogram
      --    is called and destroy when the subprogram exit.
      --  * an instance storage when declared inside a process.  This storage
      --    can be accessed from the process via an instance pointer, is
      --    created during elaboration.
      --procedure Push_Global_Factory (Storage : O_Storage);
      --procedure Pop_Global_Factory;
      procedure Set_Global_Storage (Storage : O_Storage);

      --  Set the global scope handling.
      Global_Storage : O_Storage;

      --  Start to build an instance.
      --  If INSTANCE_TYPE is not O_TNODE_NULL, it must be an uncompleted
      --  record type, that will be completed.
      procedure Push_Instance_Factory (Instance_Type : O_Tnode);
      --  Manually add a field to the current instance being built.
      function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
        return O_Fnode;
      --  Finish the building of the current instance and return the type
      --  built.
      procedure Pop_Instance_Factory (Instance_Type : out O_Tnode);

      --  Create a new scope, in which variable are created locally
      --  (ie, on the stack).  Always created unlocked.
      procedure Push_Local_Factory;

      --  Destroy a local scope.
      procedure Pop_Local_Factory;

      --  Push_scope defines how to access to a variable stored in an instance.
      --  Variables defined in SCOPE_TYPE can be accessed via field SCOPE_FIELD
      --  in scope SCOPE_PARENT.
      procedure Push_Scope (Scope_Type : O_Tnode;
                            Scope_Field : O_Fnode; Scope_Parent : O_Tnode);
      --  Variables defined in SCOPE_TYPE can be accessed by dereferencing
      --  field SCOPE_FIELD defined in SCOPE_PARENT.
      procedure Push_Scope_Via_Field_Ptr
        (Scope_Type : O_Tnode;
         Scope_Field : O_Fnode; Scope_Parent : O_Tnode);
      --  Variables/scopes defined in SCOPE_TYPE can be accessed via
      --  dereference of parameter SCOPE_PARAM.
      procedure Push_Scope (Scope_Type : O_Tnode; Scope_Param : O_Dnode);
      --  No more accesses to SCOPE_TYPE are allowed.
      --  Scopes must be poped in the reverse order they are pushed.
      procedure Pop_Scope (Scope_Type : O_Tnode);

      --  Reset the identifier.
      type Id_Mark_Type is limited private;
      type Local_Identifier_Type is limited private;

      procedure Reset_Identifier_Prefix;
      procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type;
                                        Name : String;
                                        Val : Iir_Int32 := 0);
      procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type;
                                        Name : Name_Id;
                                        Val : Iir_Int32 := 0);
      procedure Push_Identifier_Prefix_Uniq (Mark : out Id_Mark_Type);
      procedure Pop_Identifier_Prefix (Mark : in Id_Mark_Type);

      --  Save/restore the local identifier number; this is used by package
      --  body, which has the same prefix as the package declaration, so it
      --  must continue local identifiers numbers.
      --  This is used by subprogram bodies too.
      procedure Save_Local_Identifier (Id : out Local_Identifier_Type);
      procedure Restore_Local_Identifier (Id : Local_Identifier_Type);

      --  Create an identifier from IIR node ID without the prefix.
      function Create_Identifier_Without_Prefix (Id : Iir)
        return O_Ident;
      function Create_Identifier_Without_Prefix (Id : Name_Id; Str : String)
        return O_Ident;

      --  Create an identifier from the current prefix.
      function Create_Identifier return O_Ident;

      --  Create an identifier from IIR node ID with prefix.
      function Create_Identifier (Id : Iir; Str : String := "")
        return O_Ident;
      function Create_Identifier
        (Id : Iir; Val : Iir_Int32; Str : String := "")
        return O_Ident;
      function Create_Identifier (Id : Name_Id; Str : String := "")
        return O_Ident;
      --  Create a prefixed identifier from a string.
      function Create_Identifier (Str : String) return O_Ident;

      --  Create an identifier for a variable.
      --  IE, if the variable is global, prepend the prefix,
      --   if the variable belong to an instance, no prefix is added.
      type Var_Ident_Type is private;
      --function Create_Var_Identifier (Id : Name_Id; Str : String)
      --  return Var_Ident_Type;
      function Create_Var_Identifier (Id : Iir) return Var_Ident_Type;
      function Create_Var_Identifier (Id : String) return Var_Ident_Type;
      function Create_Var_Identifier (Id : Iir; Str : String; Val : Natural)
                                     return Var_Ident_Type;
      function Create_Uniq_Identifier return Var_Ident_Type;

      type Var_Type (<>) is limited private;
      type Var_Acc is access Var_Type;

      --  Create a variable in the current scope.
      --  If the current scope is the global scope, then a variable is
      --   created at the top level (using decl_global_storage).
      --  If the current scope is not the global scope, then a field is added
      --   to the current scope.
      function Create_Var
        (Name : Var_Ident_Type;
         Vtype : O_Tnode;
         Storage : O_Storage := Global_Storage)
        return Var_Acc;

      --  Create a global variable.
      function Create_Global_Var
        (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
        return Var_Acc;

      --  Create a global constant and initialize it to INITIAL_VALUE.
      function Create_Global_Const
        (Name : O_Ident;
         Vtype : O_Tnode;
         Storage : O_Storage;
         Initial_Value : O_Cnode)
      return Var_Acc;
      procedure Define_Global_Const (Const : Var_Acc; Val : O_Cnode);

      --  Return the (real) reference to a variable created by Create_Var.
      function Get_Var (Var : Var_Acc) return O_Lnode;

      procedure Free_Var (Var : in out Var_Acc);

      --  Return a reference to the instance of type ITYPE.
      function Get_Instance_Ref (Itype : O_Tnode) return O_Lnode;

      --  Return the address of the instance for block BLOCK.
      function Get_Instance_Access (Block : Iir) return O_Enode;

      --  Return the storage for the variable VAR.
      function Get_Alloc_Kind_For_Var (Var : Var_Acc) return Allocation_Kind;

      --  Return TRUE iff VAR is stable, ie get_var (VAR) can be referenced
      --  several times.
      function Is_Var_Stable (Var : Var_Acc) return Boolean;

      --  Used only to generate RTI.
      function Is_Var_Field (Var : Var_Acc) return Boolean;
      function Get_Var_Field (Var : Var_Acc) return O_Fnode;
      function Get_Var_Record (Var : Var_Acc) return O_Tnode;
      function Get_Var_Label (Var : Var_Acc) return O_Dnode;
   private
      type Local_Identifier_Type is new Natural;
      type Id_Mark_Type is record
         Len : Natural;
         Local_Id : Local_Identifier_Type;
      end record;

      type Var_Ident_Type is record
         Id : O_Ident;
      end record;

      --  Kind of variable:
      --  VAR_GLOBAL: the variable is a global variable (static or not).
      --  VAR_LOCAL: the variable is on the stack.
      --  VAR_SCOPE: the variable is in the instance record.
      type Var_Kind is (Var_Global, Var_Scope, Var_Local);

      --  An instance contains all the data (variable, signals, constant...)
      --  which are declared by an entity and an architecture.
      --  (An architecture inherits the data of its entity).
      --
      --  The processes and implicit guard signals of an entity/architecture
      --  are translated into functions.  The first argument of these functions
      --  is a pointer to the instance.

      type Inst_Build_Kind_Type is (Local, Global, Instance);
      type Inst_Build_Type (Kind : Inst_Build_Kind_Type);
      type Inst_Build_Acc is access Inst_Build_Type;
      type Inst_Build_Type (Kind : Inst_Build_Kind_Type) is record
         Prev : Inst_Build_Acc;
         Prev_Id_Start : Natural;
         case Kind is
            when Local =>
               --  Previous global storage.
               Prev_Global_Storage : O_Storage;
            when Global =>
               null;
            when Instance =>
               Elements : O_Element_List;
               Vars : Var_Acc;
         end case;
      end record;

      type Var_Type (Kind : Var_Kind) is record
         case Kind is
            when Var_Global
              | Var_Local =>
               E : O_Dnode;
            when Var_Scope =>
               I_Field : O_Fnode;
               I_Type : O_Tnode;
               I_Link : Var_Acc;
         end case;
      end record;
   end Chap10;
   use Chap10;

   package Chap1 is
      --  Declare types for block BLK
      procedure Start_Block_Decl (Blk : Iir);

      procedure Translate_Entity_Declaration (Entity : Iir_Entity_Declaration);

      --  Generate code to initialize generics of instance INSTANCE of ENTITY
      --  using the default values.
      --  This is used when ENTITY is at the top of a design hierarchy.
      procedure Translate_Entity_Init (Entity : Iir);

      procedure Translate_Architecture_Body (Arch : Iir);

      --  CONFIG may be one of:
      --  * configuration_declaration
      --  * component_configuration
      procedure Translate_Configuration_Declaration (Config : Iir);
   end Chap1;

   package Chap2 is
      --  Subprogram specification being currently translated.  This is used
      --  for the return statement.
      Current_Subprogram : Iir := Null_Iir;

      procedure Translate_Subprogram_Interfaces (Spec : Iir);
      procedure Elab_Subprogram_Interfaces (Spec : Iir);

      procedure Translate_Subprogram_Declaration (Spec : Iir);
      procedure Translate_Subprogram_Body (Subprg : Iir);

      --  Set the identifier prefix with the subprogram identifier and
      --  overload number if any.
      procedure Push_Subprg_Identifier (Spec : Iir; Mark : out Id_Mark_Type);

--       procedure Translate_Protected_Subprogram_Declaration
--         (Def : Iir_Protected_Type_Declaration; Spec : Iir; Block : Iir);

      procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration);
      procedure Translate_Package_Body (Decl : Iir_Package_Body);

      procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir);

      --  Elaborate packages that DESIGN_UNIT depends on (except std.standard).
      procedure Elab_Dependence (Design_Unit: Iir_Design_Unit);

      --  Subprograms instances.
      --
      --  Subprograms declared inside entities, architecture, blocks
      --   or processes (but not inside packages) may access to data declared
      --   outside the subprogram (and this with a life longer than the
      --   subprogram life).  These data correspond to constants, variables,
      --   files, signals or types.  However these data are not shared between
      --   instances of the same entity, architecture...  Subprograms instances
      --   is the way subprograms access to these data.
      --  One subprogram instance corresponds to a record.

      --  Type to save an old instance builder.  Subprograms may have at most
      --  one instance.  If they need severals (for example a protected
      --  subprogram), the most recent one will have a reference to the
      --  previous one.
      type Subprg_Instance_Stack is limited private;

      --  Declare an instance to be added for subprograms.
      --  DECL_TYPE is the type of the instance; this should be a record.  This
      --   is used by PUSH_SCOPE.
      --  PTR_TYPE is a pointer to DECL_TYPE.
      --  IDENT is an identifier for the interface.
      --  The previous instance is stored to PREV.  It must be restored with
      --  Pop_Subprg_Instance.
      --  Add_Subprg_Instance_Interfaces will add an interface of name IDENT
      --   and type PTR_TYPE for every instance declared by
      --   PUSH_SUBPRG_INSTANCE.
      procedure Push_Subprg_Instance (Decl_Type : O_Tnode;
                                      Ptr_Type : O_Tnode;
                                      Ident : O_Ident;
                                      Prev : out Subprg_Instance_Stack);

      --  Since local subprograms has a direct access to its father interfaces,
      --  they do not required instances interfaces.
      --  These procedures are provided to temporarly disable the addition of
      --  instances interfaces. Use Pop_Subpg_Instance to restore to the
      --  previous state.
      procedure Clear_Subprg_Instance (Prev : out Subprg_Instance_Stack);

      --  Revert of the previous subprogram.
      --  Instances must be removed in opposite order they are added.
      procedure Pop_Subprg_Instance (Ident : O_Ident;
                                     Prev : Subprg_Instance_Stack);

      --  Contains the subprogram interface for the instance.
      type Subprg_Instance_Type is private;
      Null_Subprg_Instance : constant Subprg_Instance_Type;

      --  Add interfaces during the creation of a subprogram.
      procedure Add_Subprg_Instance_Interfaces
        (Interfaces : in out O_Inter_List; Vars : out Subprg_Instance_Type);

      --  Add a field in the current factory that reference the current
      --  instance.
      procedure Add_Subprg_Instance_Field (Field : out O_Fnode);

      --  Associate values to the instance interfaces during invocation of a
      --  subprogram.
      procedure Add_Subprg_Instance_Assoc
        (Assocs : in out O_Assoc_List; Vars : Subprg_Instance_Type);

      --  Assign the instance field FIELD of VAR.
      procedure Set_Subprg_Instance_Field
        (Var : O_Dnode; Field : O_Fnode; Vars : Subprg_Instance_Type);

      --  To be called at the beginning and end of a subprogram body creation.
      --  Call PUSH_SCOPE for the subprogram intances.
      procedure Start_Subprg_Instance_Use (Vars : Subprg_Instance_Type);
      procedure Finish_Subprg_Instance_Use (Vars : Subprg_Instance_Type);

      --  Call Push_Scope to reference instance from FIELD.
      procedure Start_Prev_Subprg_Instance_Use_Via_Field
        (Prev : Subprg_Instance_Stack; Field : O_Fnode);
      procedure Finish_Prev_Subprg_Instance_Use_Via_Field
        (Prev : Subprg_Instance_Stack; Field : O_Fnode);

      --  Same as above, but for IIR.
      procedure Create_Subprg_Instance (Interfaces : in out O_Inter_List;
                                        Subprg : Iir);

      procedure Start_Subprg_Instance_Use (Subprg : Iir);
      procedure Finish_Subprg_Instance_Use (Subprg : Iir);
   private
      type Subprg_Instance_Type is record
         Inter : O_Dnode;
         Inter_Type : O_Tnode;
         Inst_Type : O_Tnode;
      end record;
      Null_Subprg_Instance : constant Subprg_Instance_Type :=
        (O_Dnode_Null, O_Tnode_Null, O_Tnode_Null);

      type Subprg_Instance_Stack is record
         Decl_Type : O_Tnode;
         Ptr_Type : O_Tnode;
         Ident : O_Ident;
      end record;

      Null_Subprg_Instance_Stack : constant Subprg_Instance_Stack :=
        (O_Tnode_Null, O_Tnode_Null, O_Ident_Nul);

      Current_Subprg_Instance : Subprg_Instance_Stack :=
        Null_Subprg_Instance_Stack;
   end Chap2;

   package Chap5 is
      --  Attribute specification.
      procedure Translate_Attribute_Specification
        (Spec : Iir_Attribute_Specification);
      procedure Elab_Attribute_Specification
        (Spec : Iir_Attribute_Specification);

      --  Disconnection specification.
      procedure Elab_Disconnection_Specification
        (Spec : Iir_Disconnection_Specification);

      --  Elab an unconstrained port.
      procedure Elab_Unconstrained_Port (Port : Iir; Actual : Iir);

      --  There are 4 cases of generic/port map:
      --  1) component instantiation
      --  2) component configuration (association of a component with an entity
      --     / architecture)
      --  3) block header
      --  4) direct (entity + architecture or configuration) instantiation
      --
      --  MAPPING is the node containing the generic/port map aspects.
      procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir);
   end Chap5;


   package Chap8 is
      procedure Translate_Statements_Chain (First : Iir);

      --  Return true if there is a return statement in the chain.
      function Translate_Statements_Chain_Has_Return (First : Iir)
                                                     return Boolean;

      --  Create a case branch for CHOICE.
      --  Used by case statement and aggregates.
      procedure Translate_Case_Choice
        (Choice : Iir; Choice_Type : Iir; Blk : in out O_Case_Block);

      --  Inc or dec by VAL ITERATOR according to DIR.
      --  Used for loop statements.
      procedure Gen_Update_Iterator (Iterator : O_Dnode;
                                     Dir : Iir_Direction;
                                     Val : Unsigned_64;
                                     Itype : Iir);

      procedure Translate_Report (Stmt : Iir; Subprg : O_Dnode; Level : Iir);
   end Chap8;

   package Chap9 is
      procedure Translate_Block_Declarations (Block : Iir; Origin : Iir);
      procedure Translate_Block_Subprograms (Block : Iir; Base_Block : Iir);
      procedure Elab_Block_Declarations (Block : Iir; Base_Block : Iir);

      --  Generate code to instantiate an entity.
      --  ASPECT must be an entity_aspect.
      --  MAPPING must be a node with get_port/generic_map_aspect_list.
      --  PARENT is the block in which the instantiation is done.
      --  CONFIG_OVERRIDE, if set, is the configuration to use; if not set, the
      --    configuration to use is determined from ASPECT.
      procedure Translate_Entity_Instantiation
        (Aspect : Iir; Mapping : Iir; Parent : Iir; Config_Override : Iir);

   end Chap9;

   package Rtis is
      --  Run-Time Information (RTI) Kind.
      Ghdl_Rtik : O_Tnode;
      Ghdl_Rtik_Top : O_Cnode;
      Ghdl_Rtik_Library : O_Cnode;
      Ghdl_Rtik_Package : O_Cnode;
      Ghdl_Rtik_Package_Body : O_Cnode;
      Ghdl_Rtik_Entity : O_Cnode;
      Ghdl_Rtik_Architecture : O_Cnode;
      Ghdl_Rtik_Process : O_Cnode;
      Ghdl_Rtik_Block : O_Cnode;
      Ghdl_Rtik_If_Generate : O_Cnode;
      Ghdl_Rtik_For_Generate : O_Cnode;
      Ghdl_Rtik_Instance : O_Cnode;
      Ghdl_Rtik_Constant : O_Cnode;
      Ghdl_Rtik_Iterator : O_Cnode;
      Ghdl_Rtik_Variable : O_Cnode;
      Ghdl_Rtik_Signal : O_Cnode;
      Ghdl_Rtik_File : O_Cnode;
      Ghdl_Rtik_Port : O_Cnode;
      Ghdl_Rtik_Generic : O_Cnode;
      Ghdl_Rtik_Alias : O_Cnode;
      Ghdl_Rtik_Guard : O_Cnode;
      Ghdl_Rtik_Component : O_Cnode;
      Ghdl_Rtik_Attribute : O_Cnode;
      Ghdl_Rtik_Type_B2 : O_Cnode;
      Ghdl_Rtik_Type_E8 : O_Cnode;
      Ghdl_Rtik_Type_E32 : O_Cnode;
      Ghdl_Rtik_Type_I32 : O_Cnode;
      Ghdl_Rtik_Type_I64 : O_Cnode;
      Ghdl_Rtik_Type_F64 : O_Cnode;
      Ghdl_Rtik_Type_P32 : O_Cnode;
      Ghdl_Rtik_Type_P64 : O_Cnode;
      Ghdl_Rtik_Type_Access : O_Cnode;
      Ghdl_Rtik_Type_Array : O_Cnode;
      Ghdl_Rtik_Type_Record : O_Cnode;
      Ghdl_Rtik_Type_File : O_Cnode;
      Ghdl_Rtik_Subtype_Scalar : O_Cnode;
      Ghdl_Rtik_Subtype_Array : O_Cnode;
      Ghdl_Rtik_Subtype_Unconstrained_Array : O_Cnode;
      Ghdl_Rtik_Subtype_Record : O_Cnode;
      Ghdl_Rtik_Subtype_Access : O_Cnode;
      Ghdl_Rtik_Type_Protected : O_Cnode;
      Ghdl_Rtik_Element : O_Cnode;
      Ghdl_Rtik_Unit64 : O_Cnode;
      Ghdl_Rtik_Unitptr : O_Cnode;
      Ghdl_Rtik_Attribute_Transaction : O_Cnode;
      Ghdl_Rtik_Attribute_Quiet : O_Cnode;
      Ghdl_Rtik_Attribute_Stable : O_Cnode;
      Ghdl_Rtik_Psl_Assert : O_Cnode;
      Ghdl_Rtik_Error : O_Cnode;

      --  RTI types.
      Ghdl_Rti_Depth : O_Tnode;
      Ghdl_Rti_U8 : O_Tnode;

      --  Common node.
      Ghdl_Rti_Common : O_Tnode;
      Ghdl_Rti_Common_Kind : O_Fnode;
      Ghdl_Rti_Common_Depth : O_Fnode;
      Ghdl_Rti_Common_Mode : O_Fnode;
      Ghdl_Rti_Common_Max_Depth : O_Fnode;

      --  Node accesses and arrays.
      Ghdl_Rti_Access : O_Tnode;
      Ghdl_Rti_Array : O_Tnode;
      Ghdl_Rti_Arr_Acc : O_Tnode;

      --  Instance link.
      --  This is a structure at the beginning of each entity/architecture
      --  instance.  This allow the run-time to find the parent of an instance.
      Ghdl_Entity_Link_Type : O_Tnode;
      --  RTI for this instance.
      Ghdl_Entity_Link_Rti : O_Fnode;
      --  RTI of the parent, which has instancied the instance.
      Ghdl_Entity_Link_Parent : O_Fnode;

      Ghdl_Component_Link_Type : O_Tnode;
      --  Pointer to a Ghdl_Entity_Link_Type, which is the entity instantiated.
      Ghdl_Component_Link_Instance : O_Fnode;
      --  RTI for the component instantiation statement.
      Ghdl_Component_Link_Stmt : O_Fnode;

      --  Access to Ghdl_Entity_Link_Type.
      Ghdl_Entity_Link_Acc : O_Tnode;
      --  Access to a Ghdl_Component_Link_Type.
      Ghdl_Component_Link_Acc : O_Tnode;

      --  Generate initial rti declarations.
      procedure Rti_Initialize;

      --  Get address (as Ghdl_Rti_Access) of constant RTI.
      function New_Rti_Address (Rti : O_Dnode) return O_Cnode;

      --  Generate rtis for a library unit.
      procedure Generate_Unit (Lib_Unit : Iir);

      --  Generate a constant declaration for SIG; but do not set its value.
      procedure Generate_Signal_Rti (Sig : Iir);

      --  Generate RTIs for subprogram body BOD.
      procedure Generate_Subprogram_Body (Bod : Iir);

      --  Generate RTI for LIB.  If PUBLIC is FALSE, only generate the
      --  declaration as external.
      procedure Generate_Library (Lib : Iir_Library_Declaration;
                                  Public : Boolean);

      --  Generate RTI for the top of the hierarchy.  Return the maximum number
      --  of packages.
      procedure Generate_Top (Nbr_Pkgs : out Natural);

      --  Add two associations to ASSOC to add an rti_context for NODE.
      procedure Associate_Rti_Context
        (Assoc : in out O_Assoc_List; Node : Iir);
      procedure Associate_Null_Rti_Context (Assoc : in out O_Assoc_List);

      function Get_Context_Rti (Node : Iir) return O_Cnode;
      function Get_Context_Addr (Node : Iir) return O_Enode;
   end Rtis;

   type Ortho_Info_Kind is
     (
      Kind_Type,
      Kind_Incomplete_Type,
      Kind_Expr,
      Kind_Subprg,
      Kind_Object,
      Kind_Alias,
      Kind_Iterator,
      Kind_Interface,
      Kind_Disconnect,
      Kind_Process,
      Kind_Psl_Directive,
      Kind_Loop,
      Kind_Block,
      Kind_Component,
      Kind_Field,
      Kind_Package,
      Kind_Config,
      Kind_Assoc,
      Kind_Str_Choice,
      Kind_Design_File,
      Kind_Library
      );

   type O_Fnode_Arr is array (Natural range <>) of O_Fnode;
   type O_Fnode_Arr_Acc is access O_Fnode_Arr;
   type Ortho_Info_Type_Kind is
     (
      Kind_Type_Scalar,
      Kind_Type_Array,
      Kind_Type_Record,
      Kind_Type_File,
      Kind_Type_Protected
      );
   type O_Tnode_Array is array (Object_Kind_Type) of O_Tnode;
   type O_Fnode_Array is array (Object_Kind_Type) of O_Fnode;

   type Rti_Depth_Type is new Natural range 0 .. 255;

   type Ortho_Info_Type_Type (Kind : Ortho_Info_Type_Kind := Kind_Type_Scalar)
   is record
      --  For all types:
      --  This is the maximum depth of RTI, that is the max of the depth of
      --  the type itself and every types it depends on.
      Rti_Max_Depth : Rti_Depth_Type;

      case Kind is
         when Kind_Type_Scalar =>
            --  For scalar types:
            --  True if no need to check against low/high bound.
            Nocheck_Low : Boolean := False;
            Nocheck_Hi : Boolean := False;

            --  Ortho type for the range record type.
            Range_Type : O_Tnode;

            --  Ortho type for an access to the range record type.
            Range_Ptr_Type : O_Tnode;

            --  Tree for the range record declaration.
            Range_Var : Var_Acc;

            --  Fields of TYPE_RANGE_TYPE.
            Range_Left : O_Fnode;
            Range_Right : O_Fnode;
            Range_Dir : O_Fnode;
            Range_Length : O_Fnode;

         when Kind_Type_Array =>
            Base_Type : O_Tnode_Array;
            Base_Ptr_Type : O_Tnode_Array;
            Bounds_Type : O_Tnode;
            Bounds_Ptr_Type : O_Tnode;

            Base_Field : O_Fnode_Array;
            Bounds_Field : O_Fnode_Array;

            --  Field declaration for each dimension (1 based).
            Bounds_Vector : O_Fnode_Arr_Acc;

            --  True if the array bounds are static.
            Static_Bounds : Boolean;

            --  Variable containing the bounds for a constrained array.
            Array_Bounds : Var_Acc;

            --  Variable containing a 1 length bound for unidimensional
            --  unconstrained arrays.
            Array_1bound : Var_Acc;

            --  Variable containing the description for each index.
            Array_Index_Desc : Var_Acc;

         when Kind_Type_Record =>
            --  Variable containing the description for each element.
            Record_El_Desc : Var_Acc;

         when Kind_Type_File =>
            --  Constant containing the signature of the file.
            File_Signature : O_Dnode;

         when Kind_Type_Protected =>
            --  Init procedure for the protected type.
            Prot_Init_Subprg : O_Dnode;
            Prot_Init_Instance : Chap2.Subprg_Instance_Type;
            --  Final procedure.
            Prot_Final_Subprg : O_Dnode;
            Prot_Final_Instance : Chap2.Subprg_Instance_Type;
            --  The outer instance, if any.
            Prot_Subprg_Instance_Field : O_Fnode;
            --  The LOCK field in the object type
            Prot_Lock_Field : O_Fnode;
      end case;
   end record;

--    Ortho_Info_Type_Scalar_Init : constant Ortho_Info_Type_Type :=
--      (Kind => Kind_Type_Scalar,
--       Range_Type => O_Tnode_Null,
--       Range_Ptr_Type => O_Tnode_Null,
--       Range_Var => null,
--       Range_Left => O_Fnode_Null,
--       Range_Right => O_Fnode_Null,
--       Range_Dir => O_Fnode_Null,
--       Range_Length => O_Fnode_Null);

   Ortho_Info_Type_Array_Init : constant Ortho_Info_Type_Type :=
     (Kind => Kind_Type_Array,
      Rti_Max_Depth => 0,
      Base_Type => (O_Tnode_Null, O_Tnode_Null),
      Base_Ptr_Type => (O_Tnode_Null, O_Tnode_Null),
      Bounds_Type => O_Tnode_Null,
      Bounds_Ptr_Type => O_Tnode_Null,
      Base_Field => (O_Fnode_Null, O_Fnode_Null),
      Bounds_Field => (O_Fnode_Null, O_Fnode_Null),
      Bounds_Vector => null,
      Static_Bounds => False,
      Array_Bounds => null,
      Array_1bound => null,
      Array_Index_Desc => null);

   Ortho_Info_Type_Record_Init : constant Ortho_Info_Type_Type :=
     (Kind => Kind_Type_Record,
      Rti_Max_Depth => 0,
      Record_El_Desc => null);

   Ortho_Info_Type_File_Init : constant Ortho_Info_Type_Type :=
     (Kind => Kind_Type_File,
      Rti_Max_Depth => 0,
      File_Signature => O_Dnode_Null);

   Ortho_Info_Type_Prot_Init : constant Ortho_Info_Type_Type :=
     (Kind => Kind_Type_Protected,
      Rti_Max_Depth => 0,
      Prot_Init_Subprg => O_Dnode_Null,
      Prot_Init_Instance => Chap2.Null_Subprg_Instance,
      Prot_Final_Subprg => O_Dnode_Null,
      Prot_Subprg_Instance_Field => O_Fnode_Null,
      Prot_Final_Instance => Chap2.Null_Subprg_Instance,
      Prot_Lock_Field => O_Fnode_Null);

   --  Mode of the type; roughly speaking, this corresponds to its size
   --  (for scalars) or its layout (for composite types).
   --  Used to select library subprograms for signals.
   type Type_Mode_Type is
     (
      --  Unknown mode.
      Type_Mode_Unknown,
      --  Boolean type, with 2 elements.
      Type_Mode_B2,
      --  Enumeration with at most 256 elements.
      Type_Mode_E8,
      --  Enumeration with more than 256 elements.
      Type_Mode_E32,
      --  Integer types.
      Type_Mode_I32,
      Type_Mode_I64,
      --  Physical types.
      Type_Mode_P32,
      Type_Mode_P64,
      --  Floating point type.
      Type_Mode_F64,
      --  File type.
      Type_Mode_File,
      --  Thin access.
      Type_Mode_Acc,

      --  Fat access.
      Type_Mode_Fat_Acc,

      --  Record.
      Type_Mode_Record,
      --  Protected type
      Type_Mode_Protected,
      --  Constrained array type (length is known at compile-time).
      Type_Mode_Array,
      --  Fat array type (used for unconstrained array).
      Type_Mode_Fat_Array);

   subtype Type_Mode_Scalar is Type_Mode_Type
     range Type_Mode_B2 .. Type_Mode_F64;

   subtype Type_Mode_Non_Composite is Type_Mode_Type
     range Type_Mode_B2 .. Type_Mode_Fat_Acc;

   --  Composite types, with the vhdl meaning: record and arrays.
   subtype Type_Mode_Composite is Type_Mode_Type
     range Type_Mode_Record .. Type_Mode_Fat_Array;

   --  Array types.
   subtype Type_Mode_Arrays is Type_Mode_Type range
     Type_Mode_Array .. Type_Mode_Fat_Array;

   --  Thin types, ie types whose length is a scalar.
   subtype Type_Mode_Thin is Type_Mode_Type
     range Type_Mode_B2 .. Type_Mode_Acc;

   --  Fat types, ie types whose length is longer than a scalar.
   subtype Type_Mode_Fat is Type_Mode_Type
     range Type_Mode_Fat_Acc .. Type_Mode_Fat_Array;

   --  These parameters are passed by value, ie the argument of the subprogram
   --  is the value of the object.
   subtype Type_Mode_By_Value is Type_Mode_Type
     range Type_Mode_B2 .. Type_Mode_Acc;

   --  These parameters are passed by copy, ie a copy of the object is created
   --  and the reference of the copy is passed.  If the object is not
   --  modified by the subprogram, the object could be passed by reference.
   subtype Type_Mode_By_Copy is Type_Mode_Type
     range Type_Mode_Fat_Acc .. Type_Mode_Fat_Acc;

   --  The parameters are passed by reference, ie the argument of the
   --  subprogram is an address to the object.
   subtype Type_Mode_By_Ref is Type_Mode_Type
     range Type_Mode_Record .. Type_Mode_Fat_Array;

   --  Additional informations for a resolving function.
   type Subprg_Resolv_Info is record
      Resolv_Func : O_Dnode;
      --  Base block which the function was defined in.
      Resolv_Block : Iir;
      --  Parameter nodes.
      Var_Instance : O_Dnode;

      --  Signals
      Var_Vals : O_Dnode;
      --  Driving vector.
      Var_Vec : O_Dnode;
      --  Length of Vector.
      Var_Vlen : O_Dnode;
      Var_Nbr_Drv : O_Dnode;
      Var_Nbr_Ports : O_Dnode;
   end record;
   type Subprg_Resolv_Info_Acc is access Subprg_Resolv_Info;

   --  Complex types.
   --
   --  A complex type is not a VHDL notion, but a translation notion.
   --  A complex type is a composite type whose size is not known at compile
   --  type. This happends in VHDL because a bound can be globally static.
   --  Therefore, the length of an array may not be known at compile type,
   --  and this propagates to composite types (record and array) if they
   --  have such an element. This is different from unconstrained arrays.
   --
   --  This occurs frequently in VHDL, and could even happen within
   --  subprograms.
   --
   --  Such types are always dynamically allocated (on the stack or on the
   --  heap). They must be continuous in memory so that they could be copied
   --  via memcpy/memmove.
   --
   --  At runtime, the size of such type is computed. A builder procedure
   --  is also created to setup inner pointers. This builder procedure should
   --  be called at initialization, but also after a copy.
   --
   --  Example:
   --  1) subtype bv_type is bit_vector (l to h);
   --     variable a : bv_type
   --
   --     This is represented by a pointer to an array of bit. No need for
   --     builder procedure, as the element type is not complex. But there
   --     is a size variable for the size of bv_type
   --
   --  2) type rec1_type is record
   --       f1 : integer;
   --       f2 : bv_type;
   --     end record;
   --
   --     This is represented by a pointer to a record. The 'f2' field is
   --     an offset to an array of bit. The size of the object is the size
   --     of the record (with f2 as a pointer) + the size of bv_type.
   --     The alinment of the object is the maximum alignment of its sub-
   --     objects: rec1 and bv_type.
   --     A builder procedure is needed to initialize the 'f2' field.
   --     The memory layout is:
   --     +--------------+
   --     | rec1:     f1 |
   --     |           f2 |---+
   --     +--------------+   |
   --     | bv_type      |<--+
   --     | ...          |
   --     +--------------+
   --
   --  3) type rec2_type is record
   --      g1: rec1_type;
   --      g2: bv_type;
   --      g3: bv_type;
   --    end record;
   --
   --    This is represented by a pointer to a record.  All the three fields
   --    are offset (relative to rec2). Alignment is the maximum alignment of
   --    the sub-objects (rec2, rec1, bv_type x 3).
   --     The memory layout is:
   --     +--------------+
   --     | rec2:     g1 |---+
   --     |           g2 |---|---+
   --     |           g3 |---|---|---+
   --     +--------------+   |   |   |
   --     | rec1:     f1 |<--+   |   |
   --     |           f2 |---+   |   |
   --     +--------------+   |   |   |
   --     | bv_type (f2) |<--+   |   |
   --     | ...          |       |   |
   --     +--------------+       |   |
   --     | bv_type (g2) |<------+   |
   --     | ...          |           |
   --     +--------------+           |
   --     | bv_type (g3) |<----------+
   --     | ...          |
   --     +--------------+
   --
   --  4) type bv_arr_type is array (natural range <>) of bv_type;
   --     arr2 : bv_arr_type (1 to 4)
   --
   --     This should be represented by a pointer to bv_type.
   --     The memory layout is:
   --     +--------------+
   --     | bv_type  (1) |
   --     | ...          |
   --     +--------------+
   --     | bv_type  (2) |
   --     | ...          |
   --     +--------------+
   --     | bv_type  (3) |
   --     | ...          |
   --     +--------------+
   --     | bv_type  (4) |
   --     | ...          |
   --     +--------------+

   --  Additional info for complex types.
   type Complex_Type_Info is record
      --  Variable containing the size of the type.
      --  This is defined only for types whose size is only known at
      --  running time (and not a compile-time).
      Size_Var : Var_Acc;

      --  Variable containing the alignment of the type.
      --  Only defined for recods and for Mode_Value.
      --  Note: this is not optimal, because the alignment could be computed
      --  at compile time, but there is no way to do that with ortho (no
      --  operation on constants). Furthermore, the alignment is independent
      --  of the instance, so there could be one global variable. But this
      --  doesn't fit in the whole machinery (in particular, there is no
      --  easy way to compute it once). As the overhead is very low, no need
      --  to bother with this issue.
      Align_Var : Var_Acc;

      Builder_Need_Func : Boolean;

      --  Parameters for type builders.
      --  NOTE: this is only set for types (and *not* for subtypes).
      Builder_Instance : Chap2.Subprg_Instance_Type;
      Builder_Base_Param : O_Dnode;
      Builder_Bound_Param : O_Dnode;
      Builder_Func : O_Dnode;
   end record;
   type Complex_Type_Arr_Info is array (Object_Kind_Type) of Complex_Type_Info;
   type Complex_Type_Info_Acc is access Complex_Type_Arr_Info;
   procedure Free_Complex_Type_Info is new Ada.Unchecked_Deallocation
     (Complex_Type_Arr_Info, Complex_Type_Info_Acc);

   type Assoc_Conv_Info is record
      --  The subprogram created to do the conversion.
      Subprg : O_Dnode;
      --  The local base block
      Instance_Block : Iir;
      --   and its address.
      Instance_Field : O_Fnode;
      --  The instantiated entity (if any).
      Instantiated_Entity : Iir;
      --   and its address.
      Instantiated_Field : O_Fnode;
      In_Field : O_Fnode;
      Out_Field : O_Fnode;
      Record_Type : O_Tnode;
      Record_Ptr_Type : O_Tnode;
   end record;

   type Direct_Driver_Type is record
      Sig : Iir;
      Var : Var_Acc;
   end record;
   type Direct_Driver_Arr is array (Natural range <>) of Direct_Driver_Type;
   type Direct_Drivers_Acc is access Direct_Driver_Arr;

   type Ortho_Info_Type;
   type Ortho_Info_Acc is access Ortho_Info_Type;

   type Ortho_Info_Type (Kind : Ortho_Info_Kind) is record
      case Kind is
         when Kind_Type =>
            --  Mode of the type.
            Type_Mode : Type_Mode_Type := Type_Mode_Unknown;

            --  If true, the type is (still) incomplete.
            Type_Incomplete : Boolean := False;

            --  For array only.  True if the type is constrained with locally
            --  static bounds.  May have non locally-static bounds in some
            --  of its sub-element (ie being a complex type).
            Type_Locally_Constrained : Boolean := False;

            --  Additionnal info for complex types.
            C : Complex_Type_Info_Acc := null;

            --  Ortho node which represents the type.
            --  Type                             -> Ortho type
            --   scalar                          ->  scalar
            --   record (complex or not)         ->  record
            --   constrained non-complex array   ->  constrained array
            --   constrained complex array       ->  the element
            --   unconstrained array             ->  fat pointer
            --   access to unconstrained array   ->  fat pointer
            --   access (others)                 ->  access
            --   file                            ->  file_index_type
            --   protected                       ->  instance
            Ortho_Type : O_Tnode_Array;

            --  Ortho pointer to the type.  This is always an access to the
            --  ortho_type.
            Ortho_Ptr_Type : O_Tnode_Array;

            --  Chain of temporary types to be destroyed at end of scope.
            Type_Transient_Chain : Iir := Null_Iir;

            --  More info according to the type.
            T : Ortho_Info_Type_Type;

            --  Run-time information.
            Type_Rti : O_Dnode := O_Dnode_Null;

         when Kind_Incomplete_Type =>
            --  The declaration of the incomplete type.
            Incomplete_Type : Iir;
            Incomplete_Array : Ortho_Info_Acc;

         when Kind_Expr =>
            --  Ortho tree which represents the expression, used for
            --  enumeration literals.
            Expr_Node : O_Cnode;

         when Kind_Subprg =>
            --  True if the function can return a value stored in the secondary
            --  stack.  In this case, the caller must deallocate the area
            --  allocated by the callee when the value was used.
            Use_Stack2 : Boolean := False;

            --  Subprogram declaration node.
            Ortho_Func : O_Dnode;

            --  For a function:
            --    If the return value is not composite, then this field
            --      must be O_DNODE_NULL.
            --    If the return value is a composite type, then the caller must
            --    give to the callee an area to put the result.  This area is
            --    given via an (hidden to the user) interface.  Furthermore,
            --    the function is translated into a procedure.
            --  For a procedure:
            --    If there are copy-out interfaces, they are gathered in a
            --    record and a pointer to the record is passed to the
            --    procedure.  RES_INTERFACE is the interface for this pointer.
            Res_Interface : O_Dnode := O_Dnode_Null;

            --  For a procedure with a result interface:
            --    Type definition for the record.
            Res_Record_Type : O_Tnode := O_Tnode_Null;
            --    Type definition for access to the record.
            Res_Record_Ptr : O_Tnode := O_Tnode_Null;

            --  Type of the frame record (used to unnest subprograms).
            Subprg_Frame_Type : O_Tnode := O_Tnode_Null;

            --  Instances for the subprograms.
            Subprg_Instance : Chap2.Subprg_Instance_Type :=
              Chap2.Null_Subprg_Instance;

            Subprg_Resolv : Subprg_Resolv_Info_Acc := null;

            --  Local identifier number, set by spec, continued by body.
            Subprg_Local_Id : Local_Identifier_Type;

            --  If set, return should be converted into exit out of the
            --  SUBPRG_EXIT loop and the value should be assigned to
            --  SUBPRG_RESULT, if any.
            Subprg_Exit : O_Snode := O_Snode_Null;
            Subprg_Result : O_Dnode := O_Dnode_Null;

         when Kind_Object =>
            --  For constants: set when the object is defined as a constant.
            Object_Static : Boolean;
            --  The object itself.
            Object_Var : Var_Acc;
            --  Direct driver for signal (if any).
            Object_Driver : Var_Acc := null;
            --  RTI constant for the object.
            Object_Rti : O_Dnode := O_Dnode_Null;
            --  Function to compute the value of object (used for implicit
            --   guard signal declaration).
            Object_Function : O_Dnode;

         when Kind_Alias =>
            Alias_Var : Var_Acc;
            Alias_Kind : Object_Kind_Type;

         when Kind_Iterator =>
            Iterator_Var : Var_Acc;

         when Kind_Interface =>
            --  Ortho declaration for the interface. If not null, there is
            --  a corresponding ortho parameter for the interface. While
            --  translating nested subprograms (that are unnested),
            --  Interface_Field may be set to the corresponding field in the
            --  FRAME record. So:
            --   Node: not null, Field:     null: parameter
            --   Node: not null, Field: not null: parameter with a copy in
            --                                    the FRAME record.
            --   Node: null,     Field:     null: not possible
            --   Node: null,     Field: not null: field in RESULT record
            Interface_Node : O_Dnode := O_Dnode_Null;
            --  Field of the result record for copy-out arguments of procedure.
            --  In that case, Interface_Node must be null.
            Interface_Field : O_Fnode;
            --  Type of the interface.
            Interface_Type : O_Tnode;

         when Kind_Disconnect =>
            --  Variable which contains the time_expression of the
            --  disconnection specification
            Disconnect_Var : Var_Acc;

         when Kind_Process =>
            --  Type of process declarations record.
            Process_Decls_Type : O_Tnode;

            --  Field in the parent block for the declarations in the process.
            Process_Parent_Field : O_Fnode;

            --  Subprogram for the process.
            Process_Subprg : O_Dnode;

            --  List of drivers if Flag_Direct_Drivers.
            Process_Drivers : Direct_Drivers_Acc := null;

            --  RTI for the process.
            Process_Rti_Const : O_Dnode := O_Dnode_Null;
         when Kind_Psl_Directive =>
            --  Type of assert declarations record.
            Psl_Decls_Type : O_Tnode;

            --  Field in the parent block for the declarations in the assert.
            Psl_Parent_Field : O_Fnode;

            --  Procedure for the state machine.
            Psl_Proc_Subprg : O_Dnode;
            --  Procedure for finalization.  Handles EOS.
            Psl_Proc_Final_Subprg : O_Dnode;

            --  Length of the state vector.
            Psl_Vect_Len : Natural;

            --  Type of the state vector.
            Psl_Vect_Type : O_Tnode;

            --  State vector variable.
            Psl_Vect_Var : Var_Acc;

            --  Boolean variable (for cover)
            Psl_Bool_Var : Var_Acc;

            --  RTI for the process.
            Psl_Rti_Const : O_Dnode := O_Dnode_Null;
         when Kind_Loop =>
            --  Labels for the loop.
            --  Used for exit/next from while-loop, and to exit from for-loop.
            Label_Exit : O_Snode;
            --  Used to next from for-loop, with an exit statment.
            Label_Next : O_Snode;
         when Kind_Block =>
            --  Instance type (ortho record) for declarations contained in the
            --  block/entity/architecture.
            Block_Decls_Type : O_Tnode;
            Block_Decls_Ptr_Type : O_Tnode;

            --  For Entity: field in the instance type containing link to
            --              parent.
            --  For an instantiation: link in the parent block to the instance.
            Block_Link_Field : O_Fnode;

            --  For an entity: must be o_fnode_null.
            --  For an architecture: the entity field.
            --  For a block, a component or a generate block: field in the
            --    parent instance which contains the declarations for this
            --    block.
            Block_Parent_Field : O_Fnode;

            --  For a generate block: field in the block providing a chain to
            --  the previous block (note: this may not be the parent, but
            --  is a parent).
            Block_Origin_Field : O_Fnode;
            --  For an iterative block: boolean field set when the block
            --  is configured.  This is used to check if the block was already
            --  configured since index and slice are not compelled to be
            --  locally static.
            Block_Configured_Field : O_Fnode;

            --  For iterative generate block: array of instances.
            Block_Decls_Array_Type : O_Tnode;
            Block_Decls_Array_Ptr_Type : O_Tnode;

            --  Subprogram which elaborates the block (for entity or arch).
            Block_Elab_Subprg : O_Dnode;
            --  Size of the block instance.
            Block_Instance_Size : O_Dnode;

            --  Only for an entity: procedure that elaborate the packages this
            --  units depend on.  That must be done before elaborating the
            --  entity and before evaluating default expressions in generics.
            Block_Elab_Pkg_Subprg : O_Dnode;

            --  RTI constant for the block.
            Block_Rti_Const : O_Dnode := O_Dnode_Null;
         when Kind_Component =>
            --  Instance for the component.
            Comp_Type : O_Tnode;
            Comp_Ptr_Type : O_Tnode;
            --  Field containing a pointer to the instance link.
            Comp_Link : O_Fnode;
            --  RTI for the component.
            Comp_Rti_Const : O_Dnode;
         when Kind_Config =>
            --  Subprogram that configure the block.
            Config_Subprg : O_Dnode;
         when Kind_Field =>
            --  Node for a record element declaration.
            Field_Node : O_Fnode_Array := (O_Fnode_Null, O_Fnode_Null);
         when Kind_Package =>
            --  Subprogram which elaborate the package spec/body.
            --  External units should call the body elaborator.
            --  The spec elaborator is called only from the body elaborator.
            Package_Elab_Spec_Subprg : O_Dnode;
            Package_Elab_Body_Subprg : O_Dnode;

            --  Variable set to true when the package is elaborated.
            Package_Elab_Var : O_Dnode;

            --  RTI constant for the package.
            Package_Rti_Const : O_Dnode;

            --  Local id, set by package declaration, continued by package
            --  body.
            Package_Local_Id : Local_Identifier_Type;
         when Kind_Assoc =>
            --  Association informations.
            Assoc_In : Assoc_Conv_Info;
            Assoc_Out : Assoc_Conv_Info;
         when Kind_Str_Choice =>
            --  List of choices, used to sort them.
            Choice_Chain : Ortho_Info_Acc;
            --  Association index.
            Choice_Assoc : Natural;
            --  Corresponding choice simple expression.
            Choice_Expr : Iir;
            --  Corresponding choice.
            Choice_Parent : Iir;
         when Kind_Design_File =>
            Design_Filename : O_Dnode;
         when Kind_Library =>
            Library_Rti_Const : O_Dnode;
      end case;
   end record;

   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
     (Name => Ortho_Info_Acc, Object => Ortho_Info_Type);

   subtype Type_Info_Acc is Ortho_Info_Acc (Kind_Type);
   subtype Incomplete_Type_Info_Acc is Ortho_Info_Acc (Kind_Incomplete_Type);
   subtype Subprg_Info_Acc is Ortho_Info_Acc (Kind_Subprg);
   subtype Object_Info_Acc is Ortho_Info_Acc (Kind_Object);
   subtype Alias_Info_Acc is Ortho_Info_Acc (Kind_Alias);
   subtype Proc_Info_Acc is Ortho_Info_Acc (Kind_Process);
   subtype Psl_Info_Acc is Ortho_Info_Acc (Kind_Psl_Directive);
   subtype Loop_Info_Acc is Ortho_Info_Acc (Kind_Loop);
   subtype Block_Info_Acc is Ortho_Info_Acc (Kind_Block);
   subtype Comp_Info_Acc is Ortho_Info_Acc (Kind_Component);
   subtype Field_Info_Acc is Ortho_Info_Acc (Kind_Field);
   subtype Config_Info_Acc is Ortho_Info_Acc (Kind_Config);
   subtype Assoc_Info_Acc is Ortho_Info_Acc (Kind_Assoc);
   subtype Inter_Info_Acc is Ortho_Info_Acc (Kind_Interface);
   subtype Design_File_Info_Acc is Ortho_Info_Acc (Kind_Design_File);
   subtype Library_Info_Acc is Ortho_Info_Acc (Kind_Library);

   package Node_Infos is new GNAT.Table
     (Table_Component_Type => Ortho_Info_Acc,
      Table_Index_Type => Iir,
      Table_Low_Bound => 0,
      Table_Initial => 1024,
      Table_Increment => 100);

   procedure Update_Node_Infos
   is
      use Nodes;
      F, L : Iir;
   begin
      F := Node_Infos.Last;
      L := Nodes.Get_Last_Node;
      Node_Infos.Set_Last (L);
      Node_Infos.Table (F + 1 .. L) := (others => null);
   end Update_Node_Infos;

   procedure Set_Info (Target : Iir; Info : Ortho_Info_Acc) is
   begin
      if Node_Infos.Table (Target) /= null then
         raise Internal_Error;
      end if;
      Node_Infos.Table (Target) := Info;
   end Set_Info;

   procedure Clear_Info (Target : Iir) is
   begin
      Node_Infos.Table (Target) := null;
   end Clear_Info;

   function Get_Info (Target : Iir) return Ortho_Info_Acc is
   begin
      return Node_Infos.Table (Target);
   end Get_Info;

   --  Create an ortho_info field of kind KIND for iir node TARGET, and
   --  return it.
   function Add_Info (Target : Iir; Kind : Ortho_Info_Kind)
     return Ortho_Info_Acc
   is
      Res : Ortho_Info_Acc;
   begin
      Res := new Ortho_Info_Type (Kind);
      Set_Info (Target, Res);
      return Res;
   end Add_Info;

   procedure Free_Info (Target : Iir)
   is
      Info : Ortho_Info_Acc;
   begin
      Info := Get_Info (Target);
      if Info /= null then
         case Info.Kind is
            when Kind_Object =>
               Free_Var (Info.Object_Var);
            when Kind_Alias =>
               Free_Var (Info.Alias_Var);
            when Kind_Iterator =>
               Free_Var (Info.Iterator_Var);
            when others =>
               null;
         end case;
         Unchecked_Deallocation (Info);
         Clear_Info (Target);
      end if;
   end Free_Info;

   procedure Free_Type_Info (Info : in out Type_Info_Acc; Full : Boolean)
   is
      procedure Free is new Ada.Unchecked_Deallocation
        (O_Fnode_Arr, O_Fnode_Arr_Acc);
   begin
      case Info.T.Kind is
         when Kind_Type_Scalar =>
            Free_Var (Info.T.Range_Var);
         when Kind_Type_Array =>
            Free_Var (Info.T.Array_Bounds);
            if Full then
               Free (Info.T.Bounds_Vector);
               Free_Var (Info.T.Array_1bound);
               Free_Var (Info.T.Array_Index_Desc);
            end if;
         when Kind_Type_Record =>
            if Full then
               Free_Var (Info.T.Record_El_Desc);
            end if;
         when Kind_Type_File =>
            null;
         when Kind_Type_Protected =>
            null;
      end case;
      if Info.C /= null then
         Free_Var (Info.C (Mode_Value).Size_Var);
         Free_Var (Info.C (Mode_Signal).Size_Var);
         Free_Var (Info.C (Mode_Value).Align_Var);
         Free_Complex_Type_Info (Info.C);
      end if;
      Unchecked_Deallocation (Info);
   end Free_Type_Info;

   procedure Set_Ortho_Expr (Target : Iir; Expr : O_Cnode)
   is
      Info : Ortho_Info_Acc;
   begin
      Info := Add_Info (Target, Kind_Expr);
      Info.Expr_Node := Expr;
   end Set_Ortho_Expr;

   function Get_Ortho_Expr (Target : Iir) return O_Cnode is
   begin
      return Get_Info (Target).Expr_Node;
   end Get_Ortho_Expr;

   function Get_Ortho_Type (Target : Iir; Is_Sig : Object_Kind_Type)
     return O_Tnode is
   begin
      return Get_Info (Target).Ortho_Type (Is_Sig);
   end Get_Ortho_Type;

   function Get_Ortho_Decl (Subprg : Iir) return O_Dnode
   is
   begin
      return Get_Info (Subprg).Ortho_Func;
   end Get_Ortho_Decl;

   function Get_Resolv_Ortho_Decl (Func : Iir) return O_Dnode
   is
      Info : Subprg_Resolv_Info_Acc;
   begin
      Info := Get_Info (Func).Subprg_Resolv;
      if Info = null then
         --  Maybe the resolver is not used.
         return O_Dnode_Null;
      else
         return Info.Resolv_Func;
      end if;
   end Get_Resolv_Ortho_Decl;

   --  Return true is INFO is a type info for a composite type, ie:
   --  * a record
   --  * an array (fat or thin)
   --  * a fat pointer.
   function Is_Composite (Info : Type_Info_Acc) return Boolean;
   pragma Inline (Is_Composite);

   function Is_Composite (Info : Type_Info_Acc) return Boolean is
   begin
      return Info.Type_Mode in Type_Mode_Fat;
   end Is_Composite;

   function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean;
   pragma Inline (Is_Complex_Type);

   function Is_Complex_Type (Tinfo : Type_Info_Acc) return Boolean is
   begin
      return Tinfo.C /= null;
   end Is_Complex_Type;


   --  Convert an o_lnode to an o_enode, either by taking value or address.
   function L2e_Node (L : O_Lnode;
                      Type_Info : Type_Info_Acc;
                      Kind : Object_Kind_Type)
     return O_Enode is
   begin
      case Type_Info.Type_Mode is
         when Type_Mode_Unknown =>
            raise Internal_Error;
         when Type_Mode_Scalar
           | Type_Mode_Acc
           | Type_Mode_File =>
            return New_Value (L);
         when Type_Mode_Fat_Array
           | Type_Mode_Fat_Acc =>
            return New_Address (L, Type_Info.Ortho_Ptr_Type (Kind));
         when Type_Mode_Record
           | Type_Mode_Array
           | Type_Mode_Protected =>
            return New_Address (L, Type_Info.Ortho_Ptr_Type (Kind));
      end case;
   end L2e_Node;

   --  In order to simplify the handling of Enode/Lnode, let's introduce
   --  Mnode (yes, another node).
   --  An Mnode is a typed union, containing either an Lnode or a Enode.
   --  See Mstate for a description of the union.
   --  The real data is contained insisde a record, so that the discriminant
   --  can be changed.
   type Mnode;

   --  State of an Mmode.
   type Mstate is
     (
      --  The Mnode contains an Enode, which can be either a value or a
      --  pointer.
      --  This Mnode can be used only once.
      Mstate_E,

      --  The Mnode contains an Lnode representing a value.
      --  This Lnode can be used only once.
      Mstate_Lv,

      --  The Mnode contains an Lnode representing a pointer.
      --  This Lnode can be used only once.
      Mstate_Lp,

      --  The Mnode contains an Dnode for a variable representing a value.
      --  This Dnode may be used several times.
      Mstate_Dv,

      --  The Mnode contains an Dnode for a variable representing a pointer.
      --  This Dnode may be used several times.
      Mstate_Dp,

      --  Null Mnode.
      Mstate_Null,

      --  The Mnode is invalid (such as already used).
      Mstate_Bad);

   type Mnode1 (State : Mstate := Mstate_Bad) is record
      --  True if the object is composite (its value cannot be read directly).
      Comp : Boolean;

      --  Additionnal informations about the objects: kind and type.
      K : Object_Kind_Type;
      T : Type_Info_Acc;

      --  Ortho type of the object.
      Vtype : O_Tnode;

      --  Type for a pointer to the object.
      Ptype : O_Tnode;

      case State is
         when Mstate_E =>
            E : O_Enode;
         when Mstate_Lv =>
            Lv : O_Lnode;
         when Mstate_Lp =>
            Lp : O_Lnode;
         when Mstate_Dv =>
            Dv : O_Dnode;
         when Mstate_Dp =>
            Dp : O_Dnode;
         when Mstate_Bad
           | Mstate_Null =>
            null;
      end case;
   end record;
   --pragma Pack (Mnode1);

   type Mnode is record
      M1 : Mnode1;
   end record;

   --  Null Mnode.
   Mnode_Null : constant Mnode := Mnode'(M1 => (State => Mstate_Null,
                                                Comp => False,
                                                K => Mode_Value,
                                                Ptype => O_Tnode_Null,
                                                Vtype => O_Tnode_Null,
                                                T => null));


   --  Object kind of a Mnode
   function Get_Object_Kind (M : Mnode) return Object_Kind_Type;

   --  Transform VAR to Mnode.
   function Get_Var
     (Var : Var_Acc; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
     return Mnode;

   --  Return a stabilized node for M.
   --  The former M is not usuable anymore.
   function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode;

   --  Stabilize M.
   procedure Stabilize (M : in out Mnode);

   --  If M is not stable, create a variable containing the value of M.
   --  M must be scalar (or access).
   function Stabilize_Value (M : Mnode) return Mnode;

   --  Create a temporary of type INFO and kind KIND.
   function Create_Temp (Info : Type_Info_Acc;
                         Kind : Object_Kind_Type := Mode_Value)
                        return Mnode;

   package Chap3 is
      --  Translate the subtype of an object, since an object can define
      --  a subtype.
      --  This can be done only for a declaration.
      --  DECL must have an identifier and a type.
      procedure Translate_Object_Subtype
        (Decl : Iir; With_Vars : Boolean := True);
      procedure Elab_Object_Subtype (Def : Iir);

      --  Translate the subtype of a literal.
      --  This can be done not at declaration time, ie no variables are created
      --  for this subtype.
      --procedure Translate_Literal_Subtype (Def : Iir);

      --  Translation of a type definition:
      --  1. Create corresponding Ortho type.
      --  2. Create bounds type
      --  3. Create bounds declaration
      --  4. Create bounds constructor
      --  5. Create type descriptor declaration
      --  6. Create type descriptor constructor

      procedure Translate_Type_Definition
        (Def : Iir; With_Vars : Boolean := True);

      procedure Translate_Named_Type_Definition (Def : Iir; Id : Name_Id);
      procedure Translate_Anonymous_Type_Definition
        (Def : Iir; Transient : Boolean);

      --  Some expressions may be evaluated several times in different
      --  contexts.  Type info created for these expressions may not be
      --  shared between these contexts.
      procedure Destroy_Type_Info (Atype : Iir);

      --  Translate subprograms for types.
      procedure Translate_Type_Subprograms (Decl : Iir);

      procedure Create_Type_Definition_Type_Range (Def : Iir);
      function Create_Static_Array_Subtype_Bounds
        (Def : Iir_Array_Subtype_Definition)
        return O_Cnode;

      --  Same as Translate_type_definition only for std.standard.boolean and
      --  std.standard.bit.
      procedure Translate_Bool_Type_Definition (Def : Iir);

      procedure Call_Ghdl_Protected_Procedure (Type_Def : Iir; Proc : O_Dnode);

      procedure Translate_Protected_Type_Body (Bod : Iir);
      procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir);

      --  Translate_type_definition_Elab do 4 and 6.
      --  It generates code to do type elaboration.
      procedure Elab_Type_Declaration (Decl : Iir);
      procedure Elab_Subtype_Declaration (Decl : Iir_Subtype_Declaration);

      --  Builders.
      --  A complex type is a type whose size is not locally static.
      --
      --  The most simple example is an unidimensionnl array whose range
      --  depends on generics.
      --
      --  We call first order complex type any array whose bounds are not
      --  locally static and whose sub-element size is locally static.
      --
      --  First order complex type objects are represented by a pointer to an
      --  array of sub-element, and the storage area for the array is
      --  allocated at run-time.
      --
      --  Since a sub-element type may be a complex type, a type may be
      --  complex because one of its sub-element type is complex.
      --  EG, a record type whose one element is a complex array.
      --
      --  A type may be complex either because it is a first order complex
      --  type (ie an array whose bounds are not locally static) or because
      --  one of its sub-element type is such a type (this is recursive).
      --
      --  We call second order complex type a complex type that is not of first
      --  order.
      --  We call third order complex type a second order complex type which is
      --  an array whose bounds are not locally static.
      --
      --  In a complex type, sub-element of first order complex type are
      --  represented by a pointer.
      --  Any complex type object (constant, signal, variable, port, generic)
      --  is represented by a pointer.
      --
      --  Creation of a second or third order complex type object consists in
      --  allocating the memory and building the object.
      --  Building a object consists in setting internal pointers.
      --
      --  A complex type has always a non-null INFO.C, and its size is computed
      --  during elaboration.
      --
      --  For a second or third order complex type, INFO.C.BUILDER_NEED_FUNC
      --  is set to TRUE.

      --  Call builder for variable pointed VAR of type VAR_TYPE.
      procedure Gen_Call_Type_Builder (Var : Mnode; Var_Type : Iir);

      --  Functions for fat array.
      --  Fat array are array whose size is not known at compilation time.
      --  This corresponds to an unconstrained array or a non locally static
      --  constrained array.
      --  A fat array is a structure containing 2 fields:
      --  * base: a pointer to the data of the array.
      --  * bounds: a pointer to a structure containing as many fields as
      --    number of dimensions; these fields are a structure describing the
      --    range of the dimension.

      --  Index array BASE of type ATYPE with INDEX.
      --  INDEX must be of type ghdl_index_type, thus no bounds checks are
      --  performed.
      function Index_Base (Base : Mnode; Atype : Iir; Index : O_Enode)
        return Mnode;

      --  Same for for slicing.
      function Slice_Base (Base : Mnode; Atype : Iir; Index : O_Enode)
                          return Mnode;

      --  Get the length of the array.
      function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode;

      function Get_Bounds_Ptr_Length (Ptr : O_Dnode; Atype : Iir)
                                     return O_Enode;

      function Get_Array_Type_Length (Atype : Iir) return O_Enode;

      --  Get the base of array ARR.
      function Get_Array_Base (Arr : Mnode) return Mnode;

      --  Get the bounds of array ARR.
      function Get_Array_Bounds (Arr : Mnode) return Mnode;

      --  Get the range ot ATYPE.
      function Type_To_Range (Atype : Iir) return Mnode;

      --  Get length of range R.
      function Range_To_Length (R : Mnode) return Mnode;

      --  Get direction of range R.
      function Range_To_Dir (R : Mnode) return Mnode;

      --  Get left/right bounds for range R.
      function Range_To_Left (R : Mnode) return Mnode;
      function Range_To_Right (R : Mnode) return Mnode;

      --  Get range for dimension DIM (1 based) of array bounds B or type
      --  ATYPE.
      function Bounds_To_Range (B : Mnode; Atype : Iir; Dim : Positive)
        return Mnode;

      --  Get the range of dimension DIM (1 based) of array ARR of type ATYPE.
      function Get_Array_Range (Arr : Mnode; Atype : Iir; Dim : Positive)
        return Mnode;

      --  Get array bounds for type ATYPE.
      function Get_Array_Type_Bounds (Atype : Iir) return Mnode;

      --  Return the a pointer to the array base from variable PTR
      --  containing a pointer to array.
      function Get_Array_Ptr_Base_Ptr
        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
        return O_Lnode;

      --  Return pointer to range DIM of array pointed by PTR.
      function Get_Array_Ptr_Range_Ptr (Ptr : O_Lnode;
                                        Array_Type : Iir;
                                        Dim : Natural;
                                        Is_Sig : Object_Kind_Type)
        return O_Enode;


      function Get_Array_Bounds_Ptr
        (Arr : O_Lnode; Arr_Type : Iir; Is_Sig : Object_Kind_Type)
        return O_Enode;

      --  Return the bounds field of a fat array from variable PTR containing a
      --  pointer to a fat array.
      function Get_Array_Ptr_Bounds_Ptr
        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
        return O_Enode;

      --  Deallocate OBJ.
      procedure Gen_Deallocate (Obj : O_Enode);

      --  Performs deallocation of PARAM (the parameter of a deallocate call).
      procedure Translate_Object_Deallocation (Param : Iir);

      --  Allocate an object of type OBJ_TYPE and set RES.
      --  RES must be a stable access of type ortho_ptr_type.
      --  For an unconstrained array, BOUNDS is a pointer to the boundaries of
      --  the object, which are copied.
      procedure Translate_Object_Allocation
        (Res : in out Mnode;
         Alloc_Kind : Allocation_Kind;
         Obj_Type : Iir;
         Bounds : O_Enode);

      --  Copy SRC to DEST.
      --  Both have the same type, OTYPE.
      --  Furthermore, arrays are of the same length.
      procedure Translate_Object_Copy
        (Dest : Mnode; Src : O_Enode; Obj_Type : Iir);

      --  Get size (in bytes with type ghdl_index_type) of object OBJ.
      --  For an unconstrained array, OBJ must be really an object, otherwise,
      --  it may be a null_mnode, created by T2M.
      function Get_Object_Size (Obj : Mnode; Obj_Type : Iir) return O_Enode;

      --  Allocate the base of a fat array, whose length is determined from
      --  the bounds.
      --  RES_PTR is a pointer to the fat pointer (must be a variable that
      --  can be referenced several times).
      --  ARR_TYPE is the type of the array.
      procedure Allocate_Fat_Array_Base (Alloc_Kind : Allocation_Kind;
                                         Res : Mnode;
                                         Arr_Type : Iir);

      --  Create the bounds for SUB_TYPE.
      --  SUB_TYPE is expected to be a non-static, anonymous array type.
      procedure Create_Array_Subtype (Sub_Type : Iir; Transient : Boolean);

      --  Return TRUE if VALUE is not is the range specified by ATYPE.
      --  VALUE must be stable.
      function Not_In_Range (Value : O_Dnode; Atype : Iir) return O_Enode;

      --  Return TRUE if base type of ATYPE is larger than its bounds, ie
      --  if a value of type ATYPE may be out of range.
      function Need_Range_Check (Expr : Iir; Atype : Iir) return Boolean;

      --  Generate an error if VALUE (computed from EXPR which may be NULL_IIR
      --  if not from a tree) is not in range specified by ATYPE.
      procedure Check_Range
        (Value : O_Dnode; Expr : Iir; Atype : Iir; Loc : Iir);

      --  Insert a scalar check for VALUE of type ATYPE.  EXPR may be NULL_IIR.
      function Insert_Scalar_Check
        (Value : O_Enode; Expr : Iir; Atype : Iir; Loc : Iir)
        return O_Enode;

      --  The base type of EXPR and the base type of ATYPE must be the same.
      --  If the type is a scalar type, and if a range check is needed, this
      --  function inserts the check.  Otherwise, it returns VALUE.
      function Maybe_Insert_Scalar_Check
        (Value : O_Enode; Expr : Iir; Atype : Iir)
        return O_Enode;

      --  Check bounds length of L match bounds length of R.
      --  If L_TYPE (resp. R_TYPE) is not a thin array, then L_NODE
      --    (resp. R_NODE) are not used (and may be Mnode_Null).
      --  If L_TYPE (resp. T_TYPE) is a fat array, then L_NODE (resp. R_NODE)
      --    must designate the array.
      procedure Check_Array_Match (L_Type : Iir;
                                   L_Node : Mnode;
                                   R_Type : Iir;
                                   R_Node : Mnode;
                                   Loc : Iir);

      --  Create a subtype range to be stored into the location pointed by
      --  RANGE_PTR from length LENGTH, which is of type INDEX_TYPE.
      --  This is done according to rules 7.2.4 of LRM93, ie:
      --  direction and left bound of the range is the same of INDEX_TYPE.
      --  LENGTH and RANGE_PTR are variables. LOC is the location in case of
      --  error.
      procedure Create_Range_From_Length
        (Index_Type : Iir; Length : O_Dnode; Range_Ptr : O_Dnode; Loc : Iir);

   end Chap3;

   package Chap4 is
      --  Translate of a type declaration corresponds to the translation of
      --  its definition.
      procedure Translate_Type_Declaration (Decl : Iir);
      procedure Translate_Anonymous_Type_Declaration (Decl : Iir);
      procedure Translate_Subtype_Declaration (Decl : Iir_Subtype_Declaration);
      procedure Translate_Bool_Type_Declaration (Decl : Iir_Type_Declaration);

      --  Translate declaration DECL, which must not be a subprogram
      --  specification.
      procedure Translate_Declaration (Decl : Iir);

      --  Translate declarations, except subprograms spec and bodies.
      procedure Translate_Declaration_Chain (Parent : Iir);

      --  Translate subprograms in declaration chain of PARENT.
      --  For a global subprograms belonging to an instance (ie, subprograms
      --  declared in a block, entity or architecture), BLOCK is the info
      --  for the base block to which the subprograms belong; null if none;
      --  It is used to add an instance parameter.
      procedure Translate_Declaration_Chain_Subprograms
        (Parent : Iir; Block : Iir);

      --  Create subprograms for type/function conversion of signal
      --  associations.
      --  ENTITY is the entity instantiated, which can be either
      --   an entity_declaration (for component configuration or direct
      --   component instantiation), a component declaration (for a component
      --   instantiation) or Null_Iir (for a block header).
      --  BLOCK is the block/architecture containing the instantiation stmt.
      --  STMT is either the instantiation stmt or the block header.
      procedure Translate_Association_Subprograms
        (Stmt : Iir; Block : Iir; Base_Block : Iir; Entity : Iir);

      --  Elaborate In/Out_Conversion for ASSOC (signals only).
      --  NDEST is the data structure to be registered.
      procedure Elab_In_Conversion (Assoc : Iir; Ndest : out Mnode);
      procedure Elab_Out_Conversion (Assoc : Iir; Ndest : out Mnode);

      --  Create code to elaborate declarations.
      --  NEED_FINAL is set when at least one declaration needs to be
      --  finalized (eg: file declaration, protected objects).
      procedure Elab_Declaration_Chain
        (Parent : Iir; Need_Final : out Boolean);

      --  Finalize declarations.
      procedure Final_Declaration_Chain (Parent : Iir; Deallocate : Boolean);

      --  Translate port or generic declarations of PARENT.
      procedure Translate_Port_Chain (Parent : Iir);
      procedure Translate_Generic_Chain (Parent : Iir);

      --  Elaborate signal subtypes and allocate the storage for the object.
      procedure Elab_Signal_Declaration_Storage (Decl : Iir);

      --  Create signal object.
      --  Note: SIG can be a signal sub-element (used when signals are
      --   collapsed).
      --  If CHECK_NULL is TRUE, create the signal only if it was not yet
      --  created.
      --  PARENT is used to link the signal to its parent by rti.
      procedure Elab_Signal_Declaration_Object
        (Sig : Iir; Parent : Iir; Check_Null : Boolean);

      --  True of SIG has a direct driver.
      function Has_Direct_Driver (Sig : Iir) return Boolean;

      --  Allocate memory for direct driver if necessary.
      procedure Elab_Direct_Driver_Declaration_Storage (Decl : Iir);

      --  Generate code to create object OBJ and initialize it with value VAL.
      procedure Elab_Object_Value (Obj : Iir; Value : Iir);

      --  Allocate the storage for OBJ, if necessary.
      procedure Elab_Object_Storage (Obj : Iir);

      --  Initialize NAME/OBJ with VALUE.
      procedure Elab_Object_Init (Name : Mnode; Obj : Iir; Value : Iir);

      --  Get the ortho type for an object of type TINFO.
      function Get_Object_Type (Tinfo : Type_Info_Acc; Kind : Object_Kind_Type)
        return O_Tnode;

      --  Allocate (and build) a complex object of type OBJ_TYPE.
      --  VAR is the object to be allocated.
      procedure Allocate_Complex_Object (Obj_Type : Iir;
                                         Alloc_Kind : Allocation_Kind;
                                         Var : in out Mnode);

      --function Translate_Interface_Declaration
      --  (Decl : Iir; Subprg : Iir) return Tree;

      --  Create a record that describe thes location of an IIR node and
      --  returns the address of it.
      function Get_Location (N : Iir) return O_Dnode;

      --  Set default value to OBJ.
      procedure Init_Object (Obj : Mnode; Obj_Type : Iir);
   end Chap4;

   package Chap6 is
      --  Translate NAME.
      --  RES contains a lnode for the result. This is the object.
      --    RES can be a tree, so it may be referenced only once.
      --  SIG is true if RES is a signal object.
      function Translate_Name (Name : Iir) return Mnode;

      --  Translate signal NAME into its node (SIG) and its direct driver
      --  node (DRV).
      procedure Translate_Direct_Driver
        (Name : Iir; Sig : out Mnode; Drv : out Mnode);

      --  Same as Translate_Name, but only for formal names.
      --  If SCOPE_TYPE and SCOPE_PARAM are not null, use them for the scope
      --  of the base name.
      --  Indeed, for recursive instantiation, NAME can designates the actual
      --  and the formal.
--       function Translate_Formal_Name (Scope_Type : O_Tnode;
--                                       Scope_Param : O_Lnode;
--                                       Name : Iir)
--                                      return Mnode;

      --  Get record element EL of PREFIX.
      function Translate_Selected_Element (Prefix : Mnode;
                                           El : Iir_Element_Declaration)
        return Mnode;

--       --  Get direction/length/left bound/right bound of dimension DIM of
--       --  array ARR whose type if ARR_TYPE.
--       --  For a thin array, ARR is the array;
--       --  For a fat array, ARR is the fat array (ie the record with base and
--       --    bounds pointer) and not a pointer.
--       function Get_Array_Bound_Dir (Arr : O_Lnode;
--                                     Arr_Type : Iir;
--                                     Dim : Natural;
--                                     Is_Sig : Object_Kind_Type)
--         return O_Enode;
      function Get_Array_Bound_Length (Arr : O_Lnode;
                                       Arr_Type : Iir;
                                       Dim : Natural;
                                       Is_Sig : Object_Kind_Type)

        return O_Enode;
      function Get_Array_Ptr_Bound_Length (Ptr : O_Lnode;
                                           Arr_Type : Iir;
                                           Dim : Natural;
                                           Is_Sig : Object_Kind_Type)
        return O_Enode;
--       function Get_Array_Bound_Left (Arr : O_Lnode;
--                                      Arr_Type : Iir;
--                                      Dim : Natural;
--                                      Is_Sig : Object_Kind_Type)
--         return O_Enode;
--       function Get_Array_Bound_Right (Arr : O_Lnode;
--                                       Arr_Type : Iir;
--                                       Dim : Natural;
--                                       Is_Sig : Object_Kind_Type)
--         return O_Enode;

      --  Extract from fat array FAT_ARRAY the range corresponding to dimension
      --  DIM.
      function Fat_Array_To_Range (Fat_Array : O_Lnode;
                                   Array_Type : Iir;
                                   Dim : Natural;
                                   Is_Sig : Object_Kind_Type)
        return O_Lnode;

      procedure Gen_Bound_Error (Loc : Iir);

      --  Generate code to emit a program error.
      Prg_Err_Missing_Return : constant Natural := 1;
      Prg_Err_Block_Configured : constant Natural := 2;
      Prg_Err_Dummy_Config : constant Natural := 3;
      Prg_Err_No_Choice : constant Natural := 4;
      Prg_Err_Bad_Choice : constant Natural := 5;
      procedure Gen_Program_Error (Loc : Iir; Code : Natural);

      --  Generate code to emit a failure if COND is TRUE, indicating an
      --  index violation for dimension DIM of an array.  LOC is usually
      --  the expression which has computed the index and is used only for
      --  its location.
      procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir; Dim : Natural);

      --  Get the deepest range_expression of ATYPE.
      --   This follows 'range and 'reverse_range.
      --  Set IS_REVERSE to true if the range must be reversed.
      procedure Get_Deep_Range_Expression
        (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean);

      --  Get the offset of INDEX in the range RNG.
      --  This checks INDEX belongs to the range.
      --  RANGE_TYPE is the subtype of the array index (or the subtype of RNG).
      --  For unconstrained ranges, INDEX_EXPR must be NULL_IIR and RANGE_TYPE
      --   must be set.
      function Translate_Index_To_Offset (Rng : Mnode;
                                          Index : O_Enode;
                                          Index_Expr : Iir;
                                          Range_Type : Iir;
                                          Loc : Iir)
                                         return O_Enode;
   end Chap6;

   package Chap7 is
      --  Generic function to extract a value from a signal.
      generic
         with function Read_Value (Sig : O_Enode; Sig_Type : Iir)
           return O_Enode;
      function Translate_Signal_Value (Sig : O_Enode; Sig_Type : Iir)
        return O_Enode;

      --  Extract the effective value of SIG.
      function Translate_Signal_Effective_Value (Sig : O_Enode; Sig_Type : Iir)
                                                return O_Enode;
      function Translate_Signal_Driving_Value (Sig : O_Enode; Sig_Type : Iir)
                                              return O_Enode;

      --  Directly set the effective value of SIG with VAL.
      --  Used only by conversion.
      procedure Set_Effective_Value
        (Sig : Mnode; Sig_Type : Iir; Val : Mnode);

      procedure Set_Driving_Value
        (Sig : Mnode; Sig_Type : Iir; Val : Mnode);

      --  Translate expression EXPR into ortho tree.
      function Translate_Expression (Expr : Iir; Rtype : Iir := Null_Iir)
        return O_Enode;

      --  Translate call to function IMP.
      --  ASSOC_CHAIN is the chain of a associations for this call.
      --  OBJ, if not NULL_IIR is the protected object.
      function Translate_Function_Call
        (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
        return O_Enode;

      --  Translate range and return an lvalue containing the range.
      --  The node returned can be used only one time.
      function Translate_Range (Arange : Iir; Range_Type : Iir)
        return O_Lnode;

      --  Translate range expression EXPR and store the result into the node
      --  pointed by RES_PTR, of type RANGE_TYPE.
      procedure Translate_Range_Ptr
        (Res_Ptr : O_Dnode; Arange : Iir; Range_Type : Iir);
      function Translate_Static_Range (Arange : Iir; Range_Type : Iir)
        return O_Cnode;

      --  Same as Translate_Range_Ptr, but for a discrete range (ie: ARANGE
      --  can be a discrete subtype indication).
      procedure Translate_Discrete_Range_Ptr (Res_Ptr : O_Dnode; Arange : Iir);

      --  Return TRUE iff constant declaration DECL can be staticly defined.
      --  This is of course true if its expression is a locally static literal,
      --  but can be true in a few cases for aggregates.
      --  This function belongs to Translation, since it is defined along
      --  with the translate_static_aggregate procedure.
      function Is_Static_Constant (Decl : Iir_Constant_Declaration)
                                  return Boolean;

      --  Translate the static expression EXPR into an ortho expression whose
      --  type must be RES_TYPE.  Therefore, an implicite conversion might
      --  occurs.
      function Translate_Static_Expression (Expr : Iir; Res_Type : Iir)
        return O_Cnode;
      function Translate_Numeric_Literal (Expr : Iir; Res_Type : O_Tnode)
        return O_Cnode;

      --  Convert (if necessary) EXPR of type EXPR_TYPE to type ATYPE.
      function Translate_Implicit_Conv
        (Expr : O_Enode;
         Expr_Type : Iir;
         Atype : Iir;
         Is_Sig : Object_Kind_Type;
         Loc : Iir)
        return O_Enode;

      function Translate_Type_Conversion
        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
        return O_Enode;

      --  Convert range EXPR into ortho tree.
      --  If RANGE_TYPE /= NULL_IIR, convert bounds to RANGE_TYPE.
      --function Translate_Range (Expr : Iir; Range_Type : Iir) return O_Enode;
      function Translate_Static_Range_Left
        (Expr : Iir; Range_Type : Iir := Null_Iir)
        return O_Cnode;
      function Translate_Static_Range_Right
        (Expr : Iir; Range_Type : Iir := Null_Iir)
        return O_Cnode;
      function Translate_Static_Range_Dir (Expr : Iir) return O_Cnode;
      function Translate_Static_Range_Length (Expr : Iir) return O_Cnode;

      --  These functions evaluates left bound/right bound/length of the
      --  range expression EXPR.
      function Translate_Range_Expression_Left (Expr : Iir;
                                                Range_Type : Iir := Null_Iir)
        return O_Enode;
      function Translate_Range_Expression_Right (Expr : Iir;
                                                 Range_Type : Iir := Null_Iir)
        return O_Enode;
      function Translate_Range_Expression_Length (Expr : Iir) return O_Enode;

      --  Get the length of any range expression (ie maybe an attribute).
      function Translate_Range_Length (Expr : Iir) return O_Enode;

      --  Assign AGGR to TARGET of type TARGET_TYPE.
      procedure Translate_Aggregate
        (Target : Mnode; Target_Type : Iir; Aggr : Iir);

      --  Translate implicit functions defined by a type.
      type Implicit_Subprogram_Infos is private;
      procedure Init_Implicit_Subprogram_Infos
        (Infos : out Implicit_Subprogram_Infos);
      procedure Translate_Implicit_Subprogram
        (Subprg : Iir; Infos : in out Implicit_Subprogram_Infos);

      --  Assign EXPR to TARGET.  LOC is the location used to report errors.
      --  FIXME: do the checks.
      procedure Translate_Assign
        (Target : Mnode; Expr : Iir; Target_Type : Iir);
      procedure Translate_Assign
        (Target : Mnode;
         Val: O_Enode; Expr : Iir; Target_Type : Iir; Loc : Iir);

      --  Find the declaration of the predefined function IMP in type
      --  definition BASE_TYPE.
      function Find_Predefined_Function
        (Base_Type : Iir; Imp : Iir_Predefined_Functions)
        return Iir;

      function Translate_Lib_Operator (Left, Right : O_Enode; Func : O_Dnode)
                                      return O_Enode;
   private
      type Implicit_Subprogram_Infos is record
         Arr_Eq_Info : Subprg_Info_Acc;
         Rec_Eq_Info : Subprg_Info_Acc;
         Arr_Cmp_Info : Subprg_Info_Acc;
         Arr_Concat_Info : Subprg_Info_Acc;
         Arr_Shl_Info : Subprg_Info_Acc;
         Arr_Sha_Info : Subprg_Info_Acc;
         Arr_Rot_Info : Subprg_Info_Acc;
      end record;
   end Chap7;

   package Chap14 is
      function Translate_Array_Attribute_To_Range (Expr : Iir) return Mnode;

      --  Read signal value FIELD of signal SIG.
      function Get_Signal_Value_Field
        (Sig : O_Enode; Sig_Type : Iir; Field : O_Fnode)
        return O_Lnode;

      function Get_Signal_Field (Sig : Mnode; Field : O_Fnode) return O_Lnode;

      function Translate_Length_Array_Attribute (Expr : Iir; Rtype : Iir)
        return O_Enode;
      function Translate_Low_Array_Attribute (Expr : Iir) return O_Enode;
      function Translate_High_Array_Attribute (Expr : Iir) return O_Enode;
      function Translate_Range_Array_Attribute (Expr : Iir) return O_Lnode;
      function Translate_Right_Array_Attribute (Expr : Iir) return O_Enode;
      function Translate_Left_Array_Attribute (Expr : Iir) return O_Enode;
      function Translate_Ascending_Array_Attribute (Expr : Iir) return O_Enode;

      function Translate_High_Low_Type_Attribute
        (Attr : Iir; Is_High : Boolean) return O_Enode;

      --  Return the value of the left bound/right bound/direction of scalar
      --  type ATYPE.
      function Translate_Left_Type_Attribute (Atype : Iir) return O_Enode;
      function Translate_Right_Type_Attribute (Atype : Iir) return O_Enode;
      function Translate_Dir_Type_Attribute (Atype : Iir) return O_Enode;

      function Translate_Val_Attribute (Attr : Iir) return O_Enode;
      function Translate_Pos_Attribute (Attr : Iir; Res_Type : Iir)
                                       return O_Enode;

      function Translate_Succ_Pred_Attribute (Attr : Iir) return O_Enode;

      function Translate_Image_Attribute (Attr : Iir) return O_Enode;
      function Translate_Value_Attribute (Attr : Iir) return O_Enode;

      function Translate_Event_Attribute (Attr : Iir) return O_Enode;
      function Translate_Active_Attribute (Attr : Iir) return O_Enode;
      function Translate_Last_Value_Attribute (Attr : Iir) return O_Enode;

      function Translate_Last_Time_Attribute (Prefix : Iir; Field : O_Fnode)
                                             return O_Enode;

      function Translate_Driving_Value_Attribute (Attr : Iir) return O_Enode;

      function Translate_Driving_Attribute (Attr : Iir) return O_Enode;

      function Translate_Path_Instance_Name_Attribute (Attr : Iir)
                                                      return O_Enode;
   end Chap14;

   package Helpers is
      --  Return the value of field FIELD of lnode L that is contains
      --   a pointer to a record.
      --  This is equivalent to:
      --  new_value (new_selected_element (new_access_element (new_value (l)),
      --                                   field))
      function New_Value_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
        return O_Enode;
      function New_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
        return O_Lnode;

      function New_Indexed_Acc_Value (L : O_Lnode; I : O_Enode) return O_Lnode;

      --  Equivalent to new_access_element (new_value (l))
      function New_Acc_Value (L : O_Lnode) return O_Lnode;

      --  Copy a fat pointer.
      --  D and S are stabilized fat pointers.
      procedure Copy_Fat_Pointer (D : Mnode; S: Mnode);

      --  Copy a fat access.
      --  D and S are variable containing address of the fat pointer.
      --  PTR_TYPE is the type of the fat access.
      procedure Copy_Fat_Access (D : O_Dnode; S : O_Dnode; Ptr_Type : Iir);

      --  Generate code to initialize a ghdl_index_type variable V to 0.
      procedure Init_Var (V : O_Dnode);

      --  Generate code to increment/decrement a ghdl_index_type variable V.
      procedure Inc_Var (V : O_Dnode);
      --procedure Dec_Var (V : O_Lnode);

      --  Generate code to exit from loop LABEL iff COND is true.
      procedure Gen_Exit_When (Label : O_Snode; Cond : O_Enode);

      --  Create a uniq identifier.
      subtype Uniq_Identifier_String is String (1 .. 11);
      function Create_Uniq_Identifier return Uniq_Identifier_String;
      function Create_Uniq_Identifier return O_Ident;

      --  Create a region for temporary variables.
      procedure Open_Temp;
      --  Create a temporary variable.
      function Create_Temp (Atype : O_Tnode) return O_Dnode;
      --  Create a temporary variable of ATYPE and initialize it with VALUE.
      function Create_Temp_Init (Atype : O_Tnode; Value : O_Enode)
        return O_Dnode;
      --  Create a temporary variable of ATYPE and initialize it with the
      --  address of NAME.
      function Create_Temp_Ptr (Atype : O_Tnode; Name : O_Lnode)
        return O_Dnode;
      --  Create a temporary variable for ATYPE and assign it with address
      --  of NAME.
      function Create_Temp_Ptr
        (Atype : Iir; Name : O_Lnode; Is_Sig : Object_Kind_Type)
        return O_Dnode;
      --  Create a mark in the temporary region for the stack2.
      --  FIXME: maybe a flag must be added to CLOSE_TEMP where it is known
      --   stack2 can be released.
      procedure Create_Temp_Stack2_Mark;
      --  Add ATYPE in the chain of types to be destroyed at the end of the
      --  temp scope.
      procedure Add_Transient_Type_In_Temp (Atype : Iir);
      --  Close the temporary region.
      procedure Close_Temp;

      --  Like Open_Temp, but will never create a declare region. To be used
      --  only within a subprogram, to use the declare region of the
      --  subprogram.
      procedure Open_Local_Temp;
      --  Destroy transient types created in a temporary region.
      procedure Destroy_Local_Transient_Types;
      procedure Close_Local_Temp;

      --  Return TRUE if stack2 will be released.  Used for fine-tuning only
      --  (return statement).
      function Has_Stack2_Mark return Boolean;
      --  Manually release stack2.  Used for fine-tuning only.
      procedure Stack2_Release;

      --  Free all old temp.
      --  Used only to free memory.
      procedure Free_Old_Temp;

      --  Return a ghdl_index_type literal for NUM.
      function New_Index_Lit (Num : Unsigned_64) return O_Cnode;

      --  Create a constant (of name ID) for string STR.
      --  Append a NUL terminator (to make interfaces with C easier).
      function Create_String (Str : String; Id : O_Ident) return O_Dnode;

      function Create_String (Str : String; Id : O_Ident; Storage : O_Storage)
                             return O_Dnode;

      function Create_String (Str : Name_Id; Id : O_Ident; Storage : O_Storage)
                             return O_Dnode;

      function Create_String_Len (Str : String; Id : O_Ident) return O_Cnode;

      procedure Gen_Memcpy (Dest : O_Enode; Src : O_Enode; Length : O_Enode);

      --  Allocate SIZE bytes aligned on the biggest alignment and return a
      --  pointer of type PTYPE.
      function Gen_Alloc
        (Kind : Allocation_Kind; Size : O_Enode; Ptype : O_Tnode)
        return O_Enode;

      --  Allocate on the heap LENGTH bytes aligned on the biggest alignment,
      --  and returns a pointer of type PTYPE.
      --function Gen_Malloc (Length : O_Enode; Ptype : O_Tnode) return O_Enode;

      --  Handle a composite type TARG/TARG_TYPE and apply DO_NON_COMPOSITE
      --  on each non composite type.
      --  There is a generic parameter DATA which may be updated
      --    before indexing an array by UPDATE_DATA_ARRAY.
      generic
         type Data_Type is private;
         type Composite_Data_Type is private;
         with procedure Do_Non_Composite (Targ : Mnode;
                                          Targ_Type : Iir;
                                          Data : Data_Type);

         --  This function should extract the base of DATA.
         with function Prepare_Data_Array (Targ : Mnode;
                                           Targ_Type : Iir;
                                           Data : Data_Type)
                                          return Composite_Data_Type;

         --  This function should index DATA.
         with function Update_Data_Array (Data : Composite_Data_Type;
                                          Targ_Type : Iir;
                                          Index : O_Dnode)
                                         return Data_Type;

         --  This function is called at the end of a record process.
         with procedure Finish_Data_Array (Data : in out Composite_Data_Type);

         --  This function should stabilize DATA.
         with function Prepare_Data_Record (Targ : Mnode;
                                            Targ_Type : Iir;
                                            Data : Data_Type)
                                           return Composite_Data_Type;

         --  This function should extract field EL of DATA.
         with function Update_Data_Record (Data : Composite_Data_Type;
                                           Targ_Type : Iir;
                                           El : Iir_Element_Declaration)
                                          return Data_Type;

         --  This function is called at the end of a record process.
         with procedure Finish_Data_Record (Data : in out Composite_Data_Type);

      procedure Foreach_Non_Composite (Targ : Mnode;
                                       Targ_Type : Iir;
                                       Data : Data_Type);

      --  Call a procedure (DATA_TYPE) for each signal of TARG.
      procedure Register_Signal
        (Targ : Mnode; Targ_Type : Iir; Proc : O_Dnode);

      --  Call PROC for each scalar signal of list LIST.
      procedure Register_Signal_List (List : Iir_List; Proc : O_Dnode);

      --  Often used subprograms for Foreach_non_composite
      --  when DATA_TYPE is o_enode.
      function Gen_Oenode_Prepare_Data_Composite
        (Targ: Mnode; Targ_Type : Iir; Val : O_Enode)
        return Mnode;
      function Gen_Oenode_Update_Data_Array (Val : Mnode;
                                             Targ_Type : Iir;
                                             Index : O_Dnode)
        return O_Enode;
      function Gen_Oenode_Update_Data_Record
        (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
        return O_Enode;
      procedure Gen_Oenode_Finish_Data_Composite (Data : in out Mnode);

      type Hexstr_Type is array (Integer range 0 .. 15) of Character;
      N2hex : constant Hexstr_Type := "0123456789abcdef";

      function Get_Line_Number (Target: Iir) return Natural;

      procedure Assoc_Filename_Line (Assoc : in out O_Assoc_List;
                                     Line : Natural);
   private
   end Helpers;
   use Helpers;

   function Get_Type_Info (M : Mnode) return Type_Info_Acc is
   begin
      return M.M1.T;
   end Get_Type_Info;

   function Get_Object_Kind (M : Mnode) return Object_Kind_Type is
   begin
      return M.M1.K;
   end Get_Object_Kind;

   function E2M (E : O_Enode; T : Type_Info_Acc; Kind : Object_Kind_Type)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_E,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, E => E,
                           Vtype => T.Ortho_Type (Kind),
                           Ptype => T.Ortho_Ptr_Type (Kind)));
   end E2M;

   function Lv2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Lv,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Lv => L,
                           Vtype => T.Ortho_Type (Kind),
                           Ptype => T.Ortho_Ptr_Type (Kind)));
   end Lv2M;

   function Lv2M (L : O_Lnode;
                  Comp : Boolean;
                  Vtype : O_Tnode;
                  Ptype : O_Tnode;
                  T : Type_Info_Acc; Kind : Object_Kind_Type)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Lv,
                           Comp => Comp,
                           K => Kind, T => T, Lv => L,
                           Vtype => Vtype, Ptype => Ptype));
   end Lv2M;

   function Lp2M (L : O_Lnode; T : Type_Info_Acc; Kind : Object_Kind_Type)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Lp,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Lp => L,
                           Vtype => T.Ortho_Type (Kind),
                           Ptype => T.Ortho_Ptr_Type (Kind)));
   end Lp2M;

   function Lp2M (L : O_Lnode;
                  T : Type_Info_Acc;
                  Kind : Object_Kind_Type;
                  Vtype : O_Tnode;
                  Ptype : O_Tnode)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Lp,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Lp => L,
                           Vtype => Vtype, Ptype => Ptype));
   end Lp2M;

   function Lv2M (L : O_Lnode;
                  T : Type_Info_Acc;
                  Kind : Object_Kind_Type;
                  Vtype : O_Tnode;
                  Ptype : O_Tnode)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Lv,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Lv => L,
                           Vtype => Vtype, Ptype => Ptype));
   end Lv2M;

   function Dv2M (D : O_Dnode;
                  T : Type_Info_Acc;
                  Kind : Object_Kind_Type)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Dv,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Dv => D,
                           Vtype => T.Ortho_Type (Kind),
                           Ptype => T.Ortho_Ptr_Type (Kind)));
   end Dv2M;

   function Dv2M (D : O_Dnode;
                  T : Type_Info_Acc;
                  Kind : Object_Kind_Type;
                  Vtype : O_Tnode;
                  Ptype : O_Tnode)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Dv,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Dv => D,
                           Vtype => Vtype,
                           Ptype => Ptype));
   end Dv2M;

   function Dp2M (D : O_Dnode;
                  T : Type_Info_Acc;
                  Kind : Object_Kind_Type;
                  Vtype : O_Tnode;
                  Ptype : O_Tnode)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Dp,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Dp => D,
                           Vtype => Vtype, Ptype => Ptype));
   end Dp2M;

   function Dp2M (D : O_Dnode;
                  T : Type_Info_Acc;
                  Kind : Object_Kind_Type)
     return Mnode is
   begin
      return Mnode'(M1 => (State => Mstate_Dp,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T, Dp => D,
                           Vtype => T.Ortho_Type (Kind),
                           Ptype => T.Ortho_Ptr_Type (Kind)));
   end Dp2M;

   function M2Lv (M : Mnode) return O_Lnode is
   begin
      case M.M1.State is
         when Mstate_E =>
            case Get_Type_Info (M).Type_Mode is
               when Type_Mode_Thin =>
                  --  Scalar to var is not possible.
                  --  FIXME: This is not coherent with the fact that this
                  --  conversion is possible when M is stabilized.
                  raise Internal_Error;
               when Type_Mode_Fat =>
                  return New_Access_Element (M.M1.E);
               when Type_Mode_Unknown =>
                  raise Internal_Error;
            end case;
         when Mstate_Lp =>
            return New_Acc_Value (M.M1.Lp);
         when Mstate_Lv =>
            return M.M1.Lv;
         when Mstate_Dp =>
            return New_Acc_Value (New_Obj (M.M1.Dp));
         when Mstate_Dv =>
            return New_Obj (M.M1.Dv);
         when Mstate_Null
           | Mstate_Bad =>
            raise Internal_Error;
      end case;
   end M2Lv;

   function M2Lp (M : Mnode) return O_Lnode is
   begin
      case M.M1.State is
         when Mstate_E =>
            raise Internal_Error;
         when Mstate_Lp =>
            return M.M1.Lp;
         when Mstate_Dp =>
            return New_Obj (M.M1.Dp);
         when Mstate_Lv =>
            if Get_Type_Info (M).Type_Mode in Type_Mode_Fat then
               return New_Obj
                 (Create_Temp_Init (M.M1.Ptype,
                                    New_Address (M.M1.Lv, M.M1.Ptype)));
            else
               raise Internal_Error;
            end if;
         when Mstate_Dv
           | Mstate_Null
           | Mstate_Bad =>
            raise Internal_Error;
      end case;
   end M2Lp;

   function M2Dp (M : Mnode) return O_Dnode is
   begin
      case M.M1.State is
         when Mstate_Dp =>
            return M.M1.Dp;
         when Mstate_Dv =>
            return Create_Temp_Init
              (M.M1.Ptype, New_Address (New_Obj (M.M1.Dv), M.M1.Ptype));

         when others =>
            raise Internal_Error;
      end case;
   end M2Dp;

   function M2Dv (M : Mnode) return O_Dnode is
   begin
      case M.M1.State is
         when Mstate_Dv =>
            return M.M1.Dv;
         when others =>
            raise Internal_Error;
      end case;
   end M2Dv;

   function T2M (Atype : Iir; Kind : Object_Kind_Type) return Mnode
   is
      T : Type_Info_Acc;
   begin
      T := Get_Info (Atype);
      return Mnode'(M1 => (State => Mstate_Null,
                           Comp => T.Type_Mode in Type_Mode_Fat,
                           K => Kind, T => T,
                           Vtype => T.Ortho_Type (Kind),
                           Ptype => T.Ortho_Ptr_Type (Kind)));
   end T2M;

   function Stabilize (M : Mnode; Can_Copy : Boolean := False) return Mnode
   is
      D : O_Dnode;
      K : Object_Kind_Type;
   begin
      K := M.M1.K;
      case M.M1.State is
         when Mstate_E =>
            if M.M1.Comp then
               D := Create_Temp_Init (M.M1.Ptype, M.M1.E);
               return Mnode'(M1 => (State => Mstate_Dp,
                                    Comp => M.M1.Comp,
                                    K => K, T => M.M1.T, Dp => D,
                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
            else
               D := Create_Temp_Init (M.M1.Vtype, M.M1.E);
               return Mnode'(M1 => (State => Mstate_Dv,
                                    Comp => M.M1.Comp,
                                    K => K, T => M.M1.T, Dv => D,
                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
            end if;
         when Mstate_Lp =>
            D := Create_Temp_Init (M.M1.Ptype, New_Value (M.M1.Lp));
            return Mnode'(M1 => (State => Mstate_Dp,
                                 Comp => M.M1.Comp,
                                 K => K, T => M.M1.T, Dp => D,
                                 Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
         when Mstate_Lv =>
            if M.M1.Ptype = O_Tnode_Null then
               if not Can_Copy then
                  raise Internal_Error;
               end if;
               D := Create_Temp_Init (M.M1.Vtype, New_Value (M.M1.Lv));
               return Mnode'(M1 => (State => Mstate_Dv,
                                    Comp => M.M1.Comp,
                                    K => K, T => M.M1.T, Dv => D,
                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));

            else
               D := Create_Temp_Ptr (M.M1.Ptype, M.M1.Lv);
               return Mnode'(M1 => (State => Mstate_Dp,
                                    Comp => M.M1.Comp,
                                    K => K, T => M.M1.T, Dp => D,
                                    Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
            end if;
         when Mstate_Dp
           | Mstate_Dv =>
            return M;
         when Mstate_Bad
           | Mstate_Null =>
            raise Internal_Error;
      end case;
   end Stabilize;

   procedure Stabilize (M : in out Mnode) is
   begin
      M := Stabilize (M);
   end Stabilize;

   function Stabilize_Value (M : Mnode) return Mnode
   is
      D : O_Dnode;
      E : O_Enode;
   begin
      --  M must be scalar or access.
      if M.M1.Comp then
         raise Internal_Error;
      end if;
      case M.M1.State is
         when Mstate_E =>
            E := M.M1.E;
         when Mstate_Lp =>
            E := New_Value (New_Acc_Value (M.M1.Lp));
         when Mstate_Lv =>
            E := New_Value (M.M1.Lv);
         when Mstate_Dp
           | Mstate_Dv =>
            return M;
         when Mstate_Bad
           | Mstate_Null =>
            raise Internal_Error;
      end case;

      D := Create_Temp_Init (M.M1.Vtype, E);
      return Mnode'(M1 => (State => Mstate_Dv,
                           Comp => M.M1.Comp,
                           K => M.M1.K, T => M.M1.T, Dv => D,
                           Vtype => M.M1.Vtype, Ptype => M.M1.Ptype));
   end Stabilize_Value;

   function M2E (M : Mnode) return O_Enode is
   begin
      case M.M1.State is
         when Mstate_E =>
            return M.M1.E;
         when Mstate_Lp =>
            case M.M1.T.Type_Mode is
               when Type_Mode_Unknown =>
                  raise Internal_Error;
               when Type_Mode_Thin =>
                  return New_Value (New_Acc_Value (M.M1.Lp));
               when Type_Mode_Fat =>
                  return New_Value (M.M1.Lp);
            end case;
         when Mstate_Dp =>
            case M.M1.T.Type_Mode is
               when Type_Mode_Unknown =>
                  raise Internal_Error;
               when Type_Mode_Thin =>
                  return New_Value (New_Acc_Value (New_Obj (M.M1.Dp)));
               when Type_Mode_Fat =>
                  return New_Value (New_Obj (M.M1.Dp));
            end case;
         when Mstate_Lv =>
            case M.M1.T.Type_Mode is
               when Type_Mode_Unknown =>
                  raise Internal_Error;
               when Type_Mode_Thin =>
                  return New_Value (M.M1.Lv);
               when Type_Mode_Fat =>
                  return New_Address (M.M1.Lv, M.M1.Ptype);
            end case;
         when Mstate_Dv =>
            case M.M1.T.Type_Mode is
               when Type_Mode_Unknown =>
                  raise Internal_Error;
               when Type_Mode_Thin =>
                  return New_Value (New_Obj (M.M1.Dv));
               when Type_Mode_Fat =>
                  return New_Address (New_Obj (M.M1.Dv), M.M1.Ptype);
            end case;
         when Mstate_Bad
           | Mstate_Null =>
            raise Internal_Error;
      end case;
   end M2E;

   function M2Addr (M : Mnode) return O_Enode is
   begin
      case M.M1.State is
         when Mstate_Lp =>
            return New_Value (M.M1.Lp);
         when Mstate_Dp =>
            return New_Value (New_Obj (M.M1.Dp));
         when Mstate_Lv =>
            return New_Address (M.M1.Lv, M.M1.Ptype);
         when Mstate_Dv =>
            return New_Address (New_Obj (M.M1.Dv), M.M1.Ptype);
         when Mstate_E =>
            if M.M1.Comp then
               return M.M1.E;
            else
               raise Internal_Error;
            end if;
         when Mstate_Bad
           | Mstate_Null =>
            raise Internal_Error;
      end case;
   end M2Addr;

--    function Is_Null (M : Mnode) return Boolean is
--    begin
--       return M.M1.State = Mstate_Null;
--    end Is_Null;

   function Is_Stable (M : Mnode) return Boolean is
   begin
      case M.M1.State is
         when Mstate_Dp
           | Mstate_Dv =>
            return True;
         when others =>
            return False;
      end case;
   end Is_Stable;

--    function Varv2M
--      (Var : Var_Acc; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
--      return Mnode is
--    begin
--       return Lv2M (Get_Var (Var), Vtype, Mode);
--    end Varv2M;

   function Varv2M (Var : Var_Acc;
                    Var_Type : Type_Info_Acc;
                    Mode : Object_Kind_Type;
                    Vtype : O_Tnode;
                    Ptype : O_Tnode)
     return Mnode is
   begin
      return Lv2M (Get_Var (Var), Var_Type, Mode, Vtype, Ptype);
   end Varv2M;

   --  Convert a Lnode for a sub object to an MNODE.
   function Lo2M (L : O_Lnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
     return Mnode is
   begin
      case Vtype.Type_Mode is
         when Type_Mode_Scalar
           | Type_Mode_Acc
           | Type_Mode_File
           | Type_Mode_Fat_Array
           | Type_Mode_Fat_Acc =>
            return Lv2M (L, Vtype, Mode);
         when Type_Mode_Array
           | Type_Mode_Record
           | Type_Mode_Protected =>
            if Is_Complex_Type (Vtype) then
               return Lp2M (L, Vtype, Mode);
            else
               return Lv2M (L, Vtype, Mode);
            end if;
         when Type_Mode_Unknown =>
            raise Internal_Error;
      end case;
   end Lo2M;

   function Lo2M (D : O_Dnode; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
     return Mnode is
   begin
      case Vtype.Type_Mode is
         when Type_Mode_Scalar
           | Type_Mode_Acc
           | Type_Mode_File
           | Type_Mode_Fat_Array
           | Type_Mode_Fat_Acc =>
            return Dv2M (D, Vtype, Mode);
         when Type_Mode_Array
           | Type_Mode_Record
           | Type_Mode_Protected =>
            if Is_Complex_Type (Vtype) then
               return Dp2M (D, Vtype, Mode);
            else
               return Dv2M (D, Vtype, Mode);
            end if;
         when Type_Mode_Unknown =>
            raise Internal_Error;
      end case;
   end Lo2M;

   function Get_Var
     (Var : Var_Acc; Vtype : Type_Info_Acc; Mode : Object_Kind_Type)
     return Mnode
   is
      L : O_Lnode;
      D : O_Dnode;
      Stable : Boolean;
   begin
      --  FIXME: there may be Vv2M and Vp2M.
      Stable := Is_Var_Stable (Var);
      if Stable then
         D := Get_Var_Label (Var);
      else
         L := Get_Var (Var);
      end if;
      case Vtype.Type_Mode is
         when Type_Mode_Scalar
           | Type_Mode_Acc
           | Type_Mode_File
           | Type_Mode_Fat_Array
           | Type_Mode_Fat_Acc =>
            if Stable then
               return Dv2M (D, Vtype, Mode);
            else
               return Lv2M (L, Vtype, Mode);
            end if;
         when Type_Mode_Array
           | Type_Mode_Record
           | Type_Mode_Protected =>
            if Is_Complex_Type (Vtype) then
               if Stable then
                  return Dp2M (D, Vtype, Mode);
               else
                  return Lp2M (L, Vtype, Mode);
               end if;
            else
               if Stable then
                  return Dv2M (D, Vtype, Mode);
               else
                  return Lv2M (L, Vtype, Mode);
               end if;
            end if;
         when Type_Mode_Unknown =>
            raise Internal_Error;
      end case;
   end Get_Var;

   function Create_Temp (Info : Type_Info_Acc;
                         Kind : Object_Kind_Type := Mode_Value)
                        return Mnode is
   begin
      if Is_Complex_Type (Info)
        and then Info.Type_Mode /= Type_Mode_Fat_Array
      then
         --  For a complex and constrained object, we just allocate
         --  a pointer to the object.
         return Dp2M (Create_Temp (Info.Ortho_Ptr_Type (Kind)), Info, Kind);
      else
         return Dv2M (Create_Temp (Info.Ortho_Type (Kind)), Info, Kind);
      end if;
   end Create_Temp;

   function Translate_Foreign_Id (Decl : Iir) return Foreign_Info_Type
   is
      use Name_Table;
      Attr : Iir_Attribute_Value;
      Spec : Iir_Attribute_Specification;
      Attr_Decl : Iir;
      Expr : Iir;
   begin
      --  Look for 'FOREIGN.
      Attr := Get_Attribute_Value_Chain (Decl);
      while Attr /= Null_Iir loop
         Spec := Get_Attribute_Specification (Attr);
         Attr_Decl := Get_Attribute_Designator (Spec);
         exit when Get_Identifier (Attr_Decl) = Std_Names.Name_Foreign;
         Attr := Get_Chain (Attr);
      end loop;
      if Attr = Null_Iir then
         --  Not found.
         raise Internal_Error;
      end if;
      Spec := Get_Attribute_Specification (Attr);
      Expr := Get_Expression (Spec);
      case Get_Kind (Expr) is
         when Iir_Kind_String_Literal =>
            declare
               Ptr : String_Fat_Acc;
            begin
               Ptr := Get_String_Fat_Acc (Expr);
               Name_Length := Natural (Get_String_Length (Expr));
               for I in 1 .. Name_Length loop
                  Name_Buffer (I) := Ptr (Nat32 (I));
               end loop;
            end;
         when Iir_Kind_Simple_Aggregate =>
            declare
               List : Iir_List;
               El : Iir;
            begin
               List := Get_Simple_Aggregate_List (Expr);
               Name_Length := 0;
               for I in Natural loop
                  El := Get_Nth_Element (List, I);
                  exit when El = Null_Iir;
                  if Get_Kind (El) /= Iir_Kind_Enumeration_Literal then
                     raise Internal_Error;
                  end if;
                  Name_Length := Name_Length + 1;
                  Name_Buffer (Name_Length) :=
                    Character'Val (Get_Enum_Pos (El));
               end loop;
            end;
         when Iir_Kind_Bit_String_Literal =>
            Error_Msg_Sem
              ("value of FOREIGN attribute cannot be a bit string", Expr);
            Name_Length := 0;
         when others =>
            if Get_Expr_Staticness (Expr) /= Locally then
               Error_Msg_Sem
                 ("value of FOREIGN attribute must be locally static", Expr);
               Name_Length := 0;
            else
               raise Internal_Error;
            end if;
      end case;

      if Name_Length = 0 then
         return Foreign_Bad;
      end if;

      --  Only 'VHPIDIRECT' is recognized.
      if Name_Length >= 10
        and then Name_Buffer (1 .. 10) = "VHPIDIRECT"
      then
         declare
            P : Natural;
            Sf, Sl : Natural;
            Lf, Ll : Natural;
         begin
            P := 11;

            --  Skip spaces.
            while P <= Name_Length and then Name_Buffer (P) = ' ' loop
               P := P + 1;
            end loop;
            if P > Name_Length then
               Error_Msg_Sem
                 ("missing subprogram/library name after VHPIDIRECT", Spec);
            end if;
            --  Extract library.
            Lf := P;
            while P < Name_Length and then Name_Buffer (P) /= ' ' loop
               P := P + 1;
            end loop;
            Ll := P;
            --  Extract subprogram.
            P := P + 1;
            while P <= Name_Length and then Name_Buffer (P) = ' ' loop
               P := P + 1;
            end loop;
            Sf := P;
            while P < Name_Length and then Name_Buffer (P) /= ' ' loop
               P := P + 1;
            end loop;
            Sl := P;
            if P < Name_Length then
               Error_Msg_Sem ("garbage at end of VHPIDIRECT", Spec);
            end if;

            --  Accept empty library.
            if Sf > Name_Length then
               Sf := Lf;
               Sl := Ll;
               Lf := 0;
               Ll := 0;
            end if;

            return Foreign_Info_Type'
              (Kind => Foreign_Vhpidirect,
               Lib_First => Lf,
               Lib_Last => Ll,
               Subprg_First => Sf,
               Subprg_Last => Sl);
         end;
      elsif Name_Length = 14
        and then Name_Buffer (1 .. 14) = "GHDL intrinsic"
      then
         return Foreign_Info_Type'(Kind => Foreign_Intrinsic);
      else
         Error_Msg_Sem
           ("value of 'FOREIGN attribute does not begin with VHPIDIRECT",
            Spec);
         return Foreign_Bad;
      end if;
   end Translate_Foreign_Id;

   package body Helpers is
      function New_Value_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
        return O_Enode is
      begin
         return New_Value
           (New_Selected_Element (New_Access_Element (New_Value (L)), Field));
      end New_Value_Selected_Acc_Value;

      function New_Selected_Acc_Value (L : O_Lnode; Field : O_Fnode)
        return O_Lnode is
      begin
         return New_Selected_Element
           (New_Access_Element (New_Value (L)), Field);
      end New_Selected_Acc_Value;

      function New_Indexed_Acc_Value (L : O_Lnode; I : O_Enode) return O_Lnode
      is
      begin
         return New_Indexed_Element (New_Access_Element (New_Value (L)), I);
      end New_Indexed_Acc_Value;

      function New_Acc_Value (L : O_Lnode) return O_Lnode is
      begin
         return New_Access_Element (New_Value (L));
      end New_Acc_Value;

      procedure Copy_Fat_Pointer (D : Mnode; S: Mnode)
      is
      begin
         New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (D)),
                          M2Addr (Chap3.Get_Array_Base (S)));
         New_Assign_Stmt (M2Lp (Chap3.Get_Array_Bounds (D)),
                          M2Addr (Chap3.Get_Array_Bounds (S)));
      end Copy_Fat_Pointer;

      procedure Copy_Fat_Pointer
        (D : O_Dnode; S : O_Dnode; Ftype : Iir; Is_Sig : Object_Kind_Type)
      is
         Info : constant Type_Info_Acc := Get_Info (Ftype);
      begin
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (D), Info.T.Base_Field (Is_Sig)),
            New_Value_Selected_Acc_Value (New_Obj (S),
                                          Info.T.Base_Field (Is_Sig)));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (D), Info.T.Bounds_Field (Is_Sig)),
            New_Value_Selected_Acc_Value (New_Obj (S),
                                          Info.T.Bounds_Field (Is_Sig)));
      end Copy_Fat_Pointer;

      procedure Copy_Fat_Access (D : O_Dnode; S : O_Dnode; Ptr_Type : Iir)
      is
      begin
         Copy_Fat_Pointer (D, S, Get_Designated_Type (Ptr_Type), Mode_Value);
      end Copy_Fat_Access;

      procedure Inc_Var (V : O_Dnode) is
      begin
         New_Assign_Stmt (New_Obj (V),
                          New_Dyadic_Op (ON_Add_Ov,
                                         New_Value (New_Obj (V)),
                                         New_Lit (Ghdl_Index_1)));
      end Inc_Var;

--       procedure Dec_Var (V : O_Lnode) is
--       begin
--          New_Assign_Stmt
--            (V, New_Dyadic_Op (ON_Sub_Ov,
--                               New_Value (V),
--                               New_Unsigned_Literal (Ghdl_Index_Type, 1)));
--       end Dec_Var;

      procedure Init_Var (V : O_Dnode) is
      begin
         New_Assign_Stmt (New_Obj (V), New_Lit (Ghdl_Index_0));
      end Init_Var;

      procedure Gen_Exit_When (Label : O_Snode; Cond : O_Enode)
      is
         If_Blk : O_If_Block;
      begin
         Start_If_Stmt (If_Blk, Cond);
         New_Exit_Stmt (Label);
         Finish_If_Stmt (If_Blk);
      end Gen_Exit_When;

      Uniq_Id : Natural := 0;

      function Create_Uniq_Identifier return Uniq_Identifier_String
      is
         Str : Uniq_Identifier_String;
         Val : Natural;
      begin
         Str (1 .. 3) := "_UI";
         Val := Uniq_Id;
         Uniq_Id := Uniq_Id + 1;
         for I in reverse 4 .. 11 loop
            Str (I) := N2hex (Val mod 16);
            Val := Val / 16;
         end loop;
         return Str;
      end Create_Uniq_Identifier;

      function Create_Uniq_Identifier return O_Ident is
      begin
         return Get_Identifier (Create_Uniq_Identifier);
      end Create_Uniq_Identifier;

      --  Create a temporary variable.
      type Temp_Level_Type;
      type Temp_Level_Acc is access Temp_Level_Type;
      type Temp_Level_Type is record
         Prev : Temp_Level_Acc;
         Level : Natural;
         Id : Natural;
         Emitted : Boolean;
         Stack2_Mark : O_Dnode;
         Transient_Types : Iir;
      end record;
      --  Current level.
      Temp_Level : Temp_Level_Acc := null;

      --  List of unused temp_level_type structures.  To be faster, they are
      --  never deallocated.
      Old_Level : Temp_Level_Acc := null;

      --  If set, emit comments for open_temp/close_temp.
      Flag_Debug_Temp : constant Boolean := False;

      procedure Open_Temp
      is
         L : Temp_Level_Acc;
      begin
         if Old_Level /= null then
            L := Old_Level;
            Old_Level := L.Prev;
         else
            L := new Temp_Level_Type;
         end if;
         L.all := (Prev => Temp_Level,
                   Level => 0,
                   Id => 0,
                   Emitted => False,
                   Stack2_Mark => O_Dnode_Null,
                   Transient_Types => Null_Iir);
         if Temp_Level /= null then
            L.Level := Temp_Level.Level + 1;
         end if;
         Temp_Level := L;
         if Flag_Debug_Temp then
            New_Debug_Comment_Stmt
              ("Open_Temp level " & Natural'Image (L.Level));
         end if;
      end Open_Temp;

      procedure Open_Local_Temp is
      begin
         Open_Temp;
         Temp_Level.Emitted := True;
      end Open_Local_Temp;

      procedure Add_Transient_Type_In_Temp (Atype : Iir)
      is
         Type_Info : Type_Info_Acc;
      begin
         Type_Info := Get_Info (Atype);
         Type_Info.Type_Transient_Chain := Temp_Level.Transient_Types;
         Temp_Level.Transient_Types := Atype;
      end Add_Transient_Type_In_Temp;

      procedure Release_Transient_Types (Chain : in out Iir) is
         N_Atype : Iir;
      begin
         while Chain /= Null_Iir loop
            N_Atype := Get_Info (Chain).Type_Transient_Chain;
            Chap3.Destroy_Type_Info (Chain);
            Chain := N_Atype;
         end loop;
      end Release_Transient_Types;

      procedure Destroy_Local_Transient_Types is
      begin
         Release_Transient_Types (Temp_Level.Transient_Types);
      end Destroy_Local_Transient_Types;

      function Has_Stack2_Mark return Boolean is
      begin
         return Temp_Level.Stack2_Mark /= O_Dnode_Null;
      end Has_Stack2_Mark;

      procedure Stack2_Release
      is
         Constr : O_Assoc_List;
      begin
         if Temp_Level.Stack2_Mark /= O_Dnode_Null then
            Start_Association (Constr, Ghdl_Stack2_Release);
            New_Association (Constr,
                             New_Value (New_Obj (Temp_Level.Stack2_Mark)));
            New_Procedure_Call (Constr);
            Temp_Level.Stack2_Mark := O_Dnode_Null;
         end if;
      end Stack2_Release;

      procedure Close_Temp
      is
         L : Temp_Level_Acc;
      begin
         if Temp_Level = null then
            --  OPEN_TEMP was not called.
            raise Internal_Error;
         end if;
         if Flag_Debug_Temp then
            New_Debug_Comment_Stmt
              ("Close_Temp level " & Natural'Image (Temp_Level.Level));
         end if;

         if Temp_Level.Stack2_Mark /= O_Dnode_Null then
            Stack2_Release;
         end if;
         if Temp_Level.Emitted then
            Finish_Declare_Stmt;
         end if;

         --  Destroy transcient types.
         Release_Transient_Types (Temp_Level.Transient_Types);

         --  Unlink temp_level.
         L := Temp_Level;
         Temp_Level := L.Prev;
         L.Prev := Old_Level;
         Old_Level := L;
      end Close_Temp;

      procedure Close_Local_Temp is
      begin
         Temp_Level.Emitted := False;
         Close_Temp;
      end Close_Local_Temp;

      procedure Free_Old_Temp
      is
         procedure Free is new Ada.Unchecked_Deallocation
           (Temp_Level_Type, Temp_Level_Acc);
         T : Temp_Level_Acc;
      begin
         if Temp_Level /= null then
            raise Internal_Error;
         end if;
         loop
            T := Old_Level;
            exit when T = null;
            Old_Level := Old_Level.Prev;
            Free (T);
         end loop;
      end Free_Old_Temp;

      procedure Create_Temp_Stack2_Mark
      is
         Constr : O_Assoc_List;
      begin
         if Temp_Level.Stack2_Mark /= O_Dnode_Null then
            --  Only the first mark in a region is registred.
            --  The release operation frees the memory allocated after the
            --  first mark.
            return;
         end if;
         Temp_Level.Stack2_Mark := Create_Temp (Ghdl_Ptr_Type);
         Start_Association (Constr, Ghdl_Stack2_Mark);
         New_Assign_Stmt (New_Obj (Temp_Level.Stack2_Mark),
                          New_Function_Call (Constr));
      end Create_Temp_Stack2_Mark;

      function Create_Temp (Atype : O_Tnode) return O_Dnode
      is
         Str : String (1 .. 12);
         Val : Natural;
         Res : O_Dnode;
         P : Natural;
      begin
         if Temp_Level = null then
            --  OPEN_TEMP was never called.
            raise Internal_Error;
            --  This is an hack, just to allow array subtype to array type
            --  conversion.
            --New_Var_Decl
            --  (Res, Create_Uniq_Identifier, O_Storage_Private, Atype);
            --return Res;
         else
            if not Temp_Level.Emitted then
               Temp_Level.Emitted := True;
               Start_Declare_Stmt;
            end if;
         end if;
         Val := Temp_Level.Id;
         Temp_Level.Id := Temp_Level.Id + 1;
         P := Str'Last;
         loop
            Str (P) := Character'Val (Val mod 10 + Character'Pos ('0'));
            Val := Val / 10;
            P := P - 1;
            exit when Val = 0;
         end loop;
         Str (P) := '_';
         P := P - 1;
         Val := Temp_Level.Level;
         loop
            Str (P) := Character'Val (Val mod 10 + Character'Pos ('0'));
            Val := Val / 10;
            P := P - 1;
            exit when Val = 0;
         end loop;
         Str (P) := 'T';
         --Str (12) := Nul;
         New_Var_Decl
           (Res, Get_Identifier (Str (P .. Str'Last)), O_Storage_Local, Atype);
         return Res;
      end Create_Temp;

      function Create_Temp_Init (Atype : O_Tnode; Value : O_Enode)
        return O_Dnode
      is
         Res : O_Dnode;
      begin
         Res := Create_Temp (Atype);
         New_Assign_Stmt (New_Obj (Res), Value);
         return Res;
      end Create_Temp_Init;

      function Create_Temp_Ptr (Atype : O_Tnode; Name : O_Lnode)
        return O_Dnode is
      begin
         return Create_Temp_Init (Atype, New_Address (Name, Atype));
      end Create_Temp_Ptr;

      function Create_Temp_Ptr
        (Atype : Iir; Name : O_Lnode; Is_Sig : Object_Kind_Type)
        return O_Dnode
      is
         Temp_Type : O_Tnode;
      begin
         Temp_Type := Get_Info (Atype).Ortho_Ptr_Type (Is_Sig);
         return Create_Temp_Init (Temp_Type, New_Address (Name, Temp_Type));
      end Create_Temp_Ptr;

      --  Return a ghdl_index_type literal for NUM.
      function New_Index_Lit (Num : Unsigned_64) return O_Cnode is
      begin
         return New_Unsigned_Literal (Ghdl_Index_Type, Num);
      end New_Index_Lit;

      --  Convert NAME into a STRING_CST.
      --  Append a NUL terminator (to make interfaces with C easier).
      function Create_String_Type (Str : String) return O_Tnode is
      begin
         return New_Constrained_Array_Type
           (Chararray_Type,
            New_Unsigned_Literal (Ghdl_Index_Type,
                                  Unsigned_64 (Str'Length + 1)));
      end Create_String_Type;

      procedure Create_String_Value
        (Const : in out O_Dnode; Const_Type : O_Tnode; Str : String)
      is
         Res : O_Cnode;
         List : O_Array_Aggr_List;
      begin
         Start_Const_Value (Const);
         Start_Array_Aggr (List, Const_Type);
         for I in Str'Range loop
            New_Array_Aggr_El
              (List,
               New_Unsigned_Literal (Char_Type_Node, Character'Pos (Str (I))));
         end loop;
         New_Array_Aggr_El (List, New_Unsigned_Literal (Char_Type_Node, 0));
         Finish_Array_Aggr (List, Res);
         Finish_Const_Value (Const, Res);
      end Create_String_Value;

      function Create_String (Str : String; Id : O_Ident) return O_Dnode
      is
         Atype : O_Tnode;
         Const : O_Dnode;
      begin
         Atype := Create_String_Type (Str);
         New_Const_Decl (Const, Id, O_Storage_Private, Atype);
         Create_String_Value (Const, Atype, Str);
         return Const;
      end Create_String;

      function Create_String (Str : String; Id : O_Ident; Storage : O_Storage)
                             return O_Dnode
      is
         Atype : O_Tnode;
         Const : O_Dnode;
      begin
         Atype := Create_String_Type (Str);
         New_Const_Decl (Const, Id, Storage, Atype);
         if Storage /= O_Storage_External then
            Create_String_Value (Const, Atype, Str);
         end if;
         return Const;
      end Create_String;

      function Create_String (Str : Name_Id; Id : O_Ident; Storage : O_Storage)
                             return O_Dnode
      is
         use Name_Table;
      begin
         if Name_Table.Is_Character (Str) then
            raise Internal_Error;
         end if;
         Image (Str);
         return Create_String (Name_Buffer (1 .. Name_Length), Id, Storage);
      end Create_String;

      function Create_String_Len (Str : String; Id : O_Ident) return O_Cnode
      is
         Str_Cst : O_Dnode;
         Str_Len : O_Cnode;
         List : O_Record_Aggr_List;
         Res : O_Cnode;
      begin
         Str_Cst := Create_String (Str, Id);
         Str_Len := New_Unsigned_Literal (Ghdl_Index_Type,
                                          Unsigned_64 (Str'Length));
         Start_Record_Aggr (List, Ghdl_Str_Len_Type_Node);
         New_Record_Aggr_El (List, Str_Len);
         New_Record_Aggr_El (List, New_Global_Address (Str_Cst,
                                                       Char_Ptr_Type));
         Finish_Record_Aggr (List, Res);
         return Res;
      end Create_String_Len;

      procedure Gen_Memcpy (Dest : O_Enode; Src : O_Enode; Length : O_Enode)
      is
         Constr : O_Assoc_List;
      begin
         Start_Association (Constr, Ghdl_Memcpy);
         New_Association (Constr, New_Convert_Ov (Dest, Ghdl_Ptr_Type));
         New_Association (Constr, New_Convert_Ov (Src, Ghdl_Ptr_Type));
         New_Association (Constr, Length);
         New_Procedure_Call (Constr);
      end Gen_Memcpy;

--       function Gen_Malloc (Length : O_Enode; Ptype : O_Tnode) return O_Enode
--       is
--          Constr : O_Assoc_List;
--       begin
--          Start_Association (Constr, Ghdl_Malloc);
--          New_Association (Constr, Length);
--          return New_Convert_Ov (New_Function_Call (Constr), Ptype);
--       end Gen_Malloc;

      function Gen_Alloc
        (Kind : Allocation_Kind; Size : O_Enode; Ptype : O_Tnode)
        return O_Enode
      is
         Constr : O_Assoc_List;
      begin
         case Kind is
            when Alloc_Heap =>
               Start_Association (Constr, Ghdl_Malloc);
               New_Association (Constr, Size);
               return New_Convert_Ov (New_Function_Call (Constr), Ptype);
            when Alloc_System =>
               Start_Association (Constr, Ghdl_Malloc0);
               New_Association (Constr, Size);
               return New_Convert_Ov (New_Function_Call (Constr), Ptype);
            when Alloc_Stack =>
               return New_Alloca (Ptype, Size);
            when Alloc_Return =>
               Start_Association (Constr, Ghdl_Stack2_Allocate);
               New_Association (Constr, Size);
               return New_Convert_Ov (New_Function_Call (Constr), Ptype);
         end case;
      end Gen_Alloc;

      procedure Foreach_Non_Composite (Targ : Mnode;
                                       Targ_Type : Iir;
                                       Data : Data_Type)
      is
         Type_Info : Type_Info_Acc;
      begin
         Type_Info := Get_Info (Targ_Type);
         case Type_Info.Type_Mode is
            when Type_Mode_Scalar =>
               Do_Non_Composite (Targ, Targ_Type, Data);
            when Type_Mode_Fat_Array
              | Type_Mode_Array =>
               declare
                  Var_Array : Mnode;
                  Var_Base : Mnode;
                  Var_Length : O_Dnode;
                  Var_I : O_Dnode;
                  Label : O_Snode;
                  Sub_Data : Data_Type;
                  Composite_Data : Composite_Data_Type;
               begin
                  Open_Temp;
                  Var_Array := Stabilize (Targ);
                  Var_Length := Create_Temp (Ghdl_Index_Type);
                  Var_Base := Stabilize (Chap3.Get_Array_Base (Var_Array));
                  New_Assign_Stmt
                    (New_Obj (Var_Length),
                     Chap3.Get_Array_Length (Var_Array, Targ_Type));
                  Composite_Data :=
                    Prepare_Data_Array (Var_Array, Targ_Type, Data);
                  if True then
                     Var_I := Create_Temp (Ghdl_Index_Type);
                  else
                     New_Var_Decl
                       (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
                  end if;
                  Init_Var (Var_I);
                  Start_Loop_Stmt (Label);
                  Gen_Exit_When
                    (Label, New_Compare_Op (ON_Ge,
                                            New_Value (New_Obj (Var_I)),
                                            New_Value (New_Obj (Var_Length)),
                                            Ghdl_Bool_Type));
                  Sub_Data := Update_Data_Array
                    (Composite_Data, Targ_Type, Var_I);
                  Foreach_Non_Composite
                    (Chap3.Index_Base (Var_Base, Targ_Type,
                                       New_Value (New_Obj (Var_I))),
                     Get_Element_Subtype (Targ_Type),
                     Sub_Data);
                  Inc_Var (Var_I);
                  Finish_Loop_Stmt (Label);
                  Finish_Data_Array (Composite_Data);
                  Close_Temp;
               end;
            when Type_Mode_Record =>
               declare
                  Var_Record : Mnode;
                  Sub_Data : Data_Type;
                  Composite_Data : Composite_Data_Type;
                  List : Iir_List;
                  El : Iir_Element_Declaration;
               begin
                  Open_Temp;
                  Var_Record := Stabilize (Targ);
                  Composite_Data :=
                    Prepare_Data_Record (Var_Record, Targ_Type, Data);
                  List := Get_Elements_Declaration_List
                    (Get_Base_Type (Targ_Type));
                  for I in Natural loop
                     El := Get_Nth_Element (List, I);
                     exit when El = Null_Iir;
                     Sub_Data := Update_Data_Record
                       (Composite_Data, Targ_Type, El);
                     Foreach_Non_Composite
                       (Chap6.Translate_Selected_Element (Var_Record, El),
                        Get_Type (El),
                        Sub_Data);
                  end loop;
                  Finish_Data_Record (Composite_Data);
                  Close_Temp;
               end;
            when others =>
               Error_Kind ("foreach_non_composite/"
                           & Type_Mode_Type'Image (Type_Info.Type_Mode),
                           Targ_Type);
         end case;
      end Foreach_Non_Composite;

      procedure Register_Non_Composite_Signal (Targ : Mnode;
                                               Targ_Type : Iir;
                                               Proc : O_Dnode)
      is
         pragma Unreferenced (Targ_Type);
         Constr : O_Assoc_List;
      begin
         Start_Association (Constr, Proc);
         New_Association
           (Constr, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
         New_Procedure_Call (Constr);
      end Register_Non_Composite_Signal;

      function Register_Update_Data_Array
        (Data : O_Dnode; Targ_Type : Iir; Index : O_Dnode)
        return O_Dnode
      is
         pragma Unreferenced (Targ_Type);
         pragma Unreferenced (Index);
      begin
         return Data;
      end Register_Update_Data_Array;

      function Register_Prepare_Data_Composite (Targ : Mnode;
                                                Targ_Type : Iir;
                                                Data : O_Dnode)
        return O_Dnode
      is
         pragma Unreferenced (Targ);
         pragma Unreferenced (Targ_Type);
      begin
         return Data;
      end Register_Prepare_Data_Composite;

      function Register_Update_Data_Record
        (Data : O_Dnode; Targ_Type : Iir; El : Iir_Element_Declaration)
        return O_Dnode
      is
         pragma Unreferenced (Targ_Type);
         pragma Unreferenced (El);
      begin
         return Data;
      end Register_Update_Data_Record;

      procedure Register_Finish_Data_Composite (D : in out O_Dnode)
      is
         pragma Unreferenced (D);
      begin
         null;
      end Register_Finish_Data_Composite;

      procedure Register_Signal_1 is new Foreach_Non_Composite
        (Data_Type => O_Dnode,
         Composite_Data_Type => O_Dnode,
         Do_Non_Composite => Register_Non_Composite_Signal,
         Prepare_Data_Array => Register_Prepare_Data_Composite,
         Update_Data_Array => Register_Update_Data_Array,
         Finish_Data_Array => Register_Finish_Data_Composite,
         Prepare_Data_Record => Register_Prepare_Data_Composite,
         Update_Data_Record => Register_Update_Data_Record,
         Finish_Data_Record => Register_Finish_Data_Composite);

      procedure Register_Signal (Targ : Mnode;
                                 Targ_Type : Iir;
                                 Proc : O_Dnode)
        renames Register_Signal_1;

      procedure Register_Signal_List (List : Iir_List; Proc : O_Dnode)
      is
         El : Iir;
         Sig : Mnode;
      begin
         if List = Null_Iir_List then
            return;
         end if;
         for I in Natural loop
            El := Get_Nth_Element (List, I);
            exit when El = Null_Iir;
            Open_Temp;
            Sig := Chap6.Translate_Name (El);
            Register_Signal (Sig, Get_Type (El), Proc);
            Close_Temp;
         end loop;
      end Register_Signal_List;

      function Gen_Oenode_Prepare_Data_Composite
        (Targ : Mnode; Targ_Type : Iir; Val : O_Enode)
        return Mnode
      is
         pragma Unreferenced (Targ);
         Res : Mnode;
         Type_Info : Type_Info_Acc;
      begin
         Type_Info := Get_Info (Targ_Type);
         Res := E2M (Val, Type_Info, Mode_Value);
         case Type_Info.Type_Mode is
            when Type_Mode_Array
              | Type_Mode_Fat_Array =>
               Res := Chap3.Get_Array_Base (Res);
            when Type_Mode_Record =>
               Res := Stabilize (Res);
            when others =>
               --  Not a composite type!
               raise Internal_Error;
         end case;
         return Res;
      end Gen_Oenode_Prepare_Data_Composite;

      function Gen_Oenode_Update_Data_Array (Val : Mnode;
                                             Targ_Type : Iir;
                                             Index : O_Dnode)
        return O_Enode
      is
      begin
         return M2E (Chap3.Index_Base (Val, Targ_Type, New_Obj_Value (Index)));
      end Gen_Oenode_Update_Data_Array;

      function Gen_Oenode_Update_Data_Record
        (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
        return O_Enode
      is
         pragma Unreferenced (Targ_Type);
      begin
         return M2E (Chap6.Translate_Selected_Element (Val, El));
      end Gen_Oenode_Update_Data_Record;

      procedure Gen_Oenode_Finish_Data_Composite (Data : in out Mnode)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Gen_Oenode_Finish_Data_Composite;

      function Get_Line_Number (Target: Iir) return Natural
      is
         Line, Col: Natural;
         Name : Name_Id;
      begin
         Files_Map.Location_To_Position
           (Get_Location (Target), Name, Line, Col);
         return Line;
      end Get_Line_Number;

      procedure Assoc_Filename_Line (Assoc : in out O_Assoc_List;
                                     Line : Natural) is
      begin
         New_Association (Assoc,
                          New_Lit (New_Global_Address (Current_Filename_Node,
                                                       Char_Ptr_Type)));
         New_Association (Assoc, New_Lit (New_Signed_Literal
                                          (Ghdl_I32_Type, Integer_64 (Line))));
      end Assoc_Filename_Line;
   end Helpers;

   package body Chap1 is
      procedure Start_Block_Decl (Blk : Iir)
      is
         Info : Block_Info_Acc;
      begin
         Info := Get_Info (Blk);
         New_Uncomplete_Record_Type (Info.Block_Decls_Type);
         New_Type_Decl (Create_Identifier ("INSTTYPE"), Info.Block_Decls_Type);
         Info.Block_Decls_Ptr_Type := New_Access_Type (Info.Block_Decls_Type);
         New_Type_Decl (Create_Identifier ("INSTPTR"),
                        Info.Block_Decls_Ptr_Type);
      end Start_Block_Decl;

      procedure Translate_Entity_Init (Entity : Iir)
      is
         El : Iir;
         El_Type : Iir;
      begin
         Push_Local_Factory;

         --  Generics.
         El := Get_Generic_Chain (Entity);
         while El /= Null_Iir loop
            Open_Temp;
            Chap4.Elab_Object_Value (El, Get_Default_Value (El));
            Close_Temp;
            El := Get_Chain (El);
         end loop;

         --  Ports.
         El := Get_Port_Chain (Entity);
         while El /= Null_Iir loop
            Open_Temp;
            El_Type := Get_Type (El);
            if not Is_Fully_Constrained_Type (El_Type) then
               Chap5.Elab_Unconstrained_Port (El, Get_Default_Value (El));
            end if;
            Chap4.Elab_Signal_Declaration_Storage (El);
            Chap4.Elab_Signal_Declaration_Object (El, Entity, False);
            Close_Temp;

            El := Get_Chain (El);
         end loop;

         Pop_Local_Factory;
      end Translate_Entity_Init;

      procedure Translate_Entity_Declaration (Entity : Iir_Entity_Declaration)
      is
         Info : Block_Info_Acc;
         Interface_List : O_Inter_List;
         Instance : Chap2.Subprg_Instance_Type;
         Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
      begin
         Info := Add_Info (Entity, Kind_Block);
         Chap1.Start_Block_Decl (Entity);
         Push_Instance_Factory (Info.Block_Decls_Type);

         --  Entity link (RTI and pointer to parent).
         Info.Block_Link_Field := Add_Instance_Factory_Field
           (Wki_Rti, Rtis.Ghdl_Entity_Link_Type);

         --  generics, ports.
         Chap4.Translate_Generic_Chain (Entity);
         Chap4.Translate_Port_Chain (Entity);

         Chap9.Translate_Block_Declarations (Entity, Entity);

         Pop_Instance_Factory (Info.Block_Decls_Type);

         Chap2.Push_Subprg_Instance (Info.Block_Decls_Type,
                                     Info.Block_Decls_Ptr_Type,
                                     Wki_Instance,
                                     Prev_Subprg_Instance);

         --  Entity elaborator.
         Start_Procedure_Decl (Interface_List, Create_Identifier ("ELAB"),
                               Global_Storage);
         Chap2.Add_Subprg_Instance_Interfaces (Interface_List, Instance);
         Finish_Subprogram_Decl (Interface_List, Info.Block_Elab_Subprg);

         --  Entity dependences elaborator.
         Start_Procedure_Decl (Interface_List, Create_Identifier ("PKG_ELAB"),
                               Global_Storage);
         Finish_Subprogram_Decl (Interface_List, Info.Block_Elab_Pkg_Subprg);

         --  Generate RTI.
         if Flag_Rti then
            Rtis.Generate_Unit (Entity);
         end if;

         if Global_Storage = O_Storage_External then
            --  Entity declaration subprograms.
            Chap4.Translate_Declaration_Chain_Subprograms (Entity, Entity);
         else
            --  Entity declaration and process subprograms.
            Chap9.Translate_Block_Subprograms (Entity, Entity);

            --  Package elaborator Body.
            Start_Subprogram_Body (Info.Block_Elab_Pkg_Subprg);
            Push_Local_Factory;
            New_Debug_Line_Stmt (Get_Line_Number (Entity));
            Chap2.Elab_Dependence (Get_Design_Unit (Entity));
            Pop_Local_Factory;
            Finish_Subprogram_Body;

            --  Elaborator Body.
            Start_Subprogram_Body (Info.Block_Elab_Subprg);
            Push_Local_Factory;
            Chap2.Start_Subprg_Instance_Use (Instance);
            New_Debug_Line_Stmt (Get_Line_Number (Entity));

            Chap9.Elab_Block_Declarations (Entity, Entity);
            Chap2.Finish_Subprg_Instance_Use (Instance);
            Pop_Local_Factory;
            Finish_Subprogram_Body;

            --  Default value if any.
            if False then --Is_Entity_Declaration_Top (Entity) then
               declare
                  Init_Subprg : O_Dnode;
               begin
                  Start_Procedure_Decl
                    (Interface_List, Create_Identifier ("_INIT"),
                     Global_Storage);
                  Chap2.Add_Subprg_Instance_Interfaces
                    (Interface_List, Instance);
                  Finish_Subprogram_Decl (Interface_List, Init_Subprg);

                  Start_Subprogram_Body (Init_Subprg);
                  Chap2.Start_Subprg_Instance_Use (Instance);
                  Translate_Entity_Init (Entity);
                  Chap2.Finish_Subprg_Instance_Use (Instance);
                  Finish_Subprogram_Body;
               end;
            end if;
         end if;
         Chap2.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);
      end Translate_Entity_Declaration;

      --  Push scope for architecture ARCH via INSTANCE, and for its
      --  entity via the entity field of the instance.
      procedure Push_Architecture_Scope (Arch : Iir; Instance : O_Dnode)
      is
         Arch_Info : Block_Info_Acc;
         Entity : Iir;
         Entity_Info : Block_Info_Acc;
      begin
         Arch_Info := Get_Info (Arch);
         Entity := Get_Entity (Arch);
         Entity_Info := Get_Info (Entity);

         Push_Scope (Arch_Info.Block_Decls_Type, Instance);
         Push_Scope (Entity_Info.Block_Decls_Type,
                     Arch_Info.Block_Parent_Field, Arch_Info.Block_Decls_Type);
      end Push_Architecture_Scope;

      --  Pop scopes created by Push_Architecture_Scope.
      procedure Pop_Architecture_Scope (Arch : Iir)
      is
         Arch_Info : Block_Info_Acc;
         Entity : Iir;
         Entity_Info : Block_Info_Acc;
      begin
         Arch_Info := Get_Info (Arch);
         Entity := Get_Entity (Arch);
         Entity_Info := Get_Info (Entity);

         Pop_Scope (Entity_Info.Block_Decls_Type);
         Pop_Scope (Arch_Info.Block_Decls_Type);
      end Pop_Architecture_Scope;

      procedure Translate_Architecture_Body (Arch : Iir)
      is
         Info : Block_Info_Acc;
         Entity : Iir;
         Entity_Info : Block_Info_Acc;
         Interface_List : O_Inter_List;
         Constr : O_Assoc_List;
         Instance : O_Dnode;
         Var_Arch_Instance : O_Dnode;
         Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
      begin
         if Get_Foreign_Flag (Arch) then
            Error_Msg_Sem ("FOREIGN architectures are not yet handled", Arch);
         end if;

         Info := Add_Info (Arch, Kind_Block);
         Start_Block_Decl (Arch);
         Push_Instance_Factory (Info.Block_Decls_Type);

         Entity := Get_Entity (Arch);
         Entity_Info := Get_Info (Entity);
         Info.Block_Parent_Field := Add_Instance_Factory_Field
           (Get_Identifier ("ENTITY"), Entity_Info.Block_Decls_Type);

         Chap9.Translate_Block_Declarations (Arch, Arch);

         Pop_Instance_Factory (Info.Block_Decls_Type);

         --  Declare the constant containing the size of the instance.
         New_Const_Decl
           (Info.Block_Instance_Size, Create_Identifier ("INSTSIZE"),
            Global_Storage, Ghdl_Index_Type);
         if Global_Storage /= O_Storage_External then
            Start_Const_Value (Info.Block_Instance_Size);
            Finish_Const_Value
              (Info.Block_Instance_Size,
               New_Sizeof (Info.Block_Decls_Type, Ghdl_Index_Type));
         end if;

         --  Elaborator.
         Start_Procedure_Decl
           (Interface_List, Create_Identifier ("ELAB"), Global_Storage);
         New_Interface_Decl
           (Interface_List, Instance, Wki_Instance,
            Entity_Info.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Interface_List, Info.Block_Elab_Subprg);

         --  Generate RTI.
         if Flag_Rti then
            Rtis.Generate_Unit (Arch);
         end if;

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Chap2.Push_Subprg_Instance (Info.Block_Decls_Type,
                                     Info.Block_Decls_Ptr_Type,
                                     Wki_Instance,
                                     Prev_Subprg_Instance);

         --  Create process subprograms.
         Push_Scope (Entity_Info.Block_Decls_Type,
                     Info.Block_Parent_Field, Info.Block_Decls_Type);
         Chap9.Translate_Block_Subprograms (Arch, Arch);
         Pop_Scope (Entity_Info.Block_Decls_Type);

         Chap2.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance);

         --  Elaborator body.
         Start_Subprogram_Body (Info.Block_Elab_Subprg);
         Push_Local_Factory;

         --  Create a variable for the architecture instance (with the right
         --  type, instead of the entity instance type).
         New_Var_Decl (Var_Arch_Instance, Wki_Arch_Instance,
                       O_Storage_Local, Info.Block_Decls_Ptr_Type);
         New_Assign_Stmt
           (New_Obj (Var_Arch_Instance),
            New_Convert_Ov (New_Value (New_Obj (Instance)),
                            Info.Block_Decls_Ptr_Type));

         --  Set RTI.
         if Flag_Rti then
            New_Assign_Stmt
              (New_Selected_Element
               (New_Selected_Acc_Value (New_Obj (Instance),
                                        Entity_Info.Block_Link_Field),
                Rtis.Ghdl_Entity_Link_Rti),
               New_Unchecked_Address (New_Obj (Info.Block_Rti_Const),
                                      Rtis.Ghdl_Rti_Access));
         end if;

         --  Call entity elaborators.
         Start_Association (Constr, Entity_Info.Block_Elab_Subprg);
         New_Association (Constr, New_Value (New_Obj (Instance)));
         New_Procedure_Call (Constr);

         Push_Architecture_Scope (Arch, Var_Arch_Instance);

         New_Debug_Line_Stmt (Get_Line_Number (Arch));
         Chap2.Elab_Dependence (Get_Design_Unit (Arch));

         Chap9.Elab_Block_Declarations (Arch, Arch);
         --Chap6.Leave_Simple_Name (Ghdl_Leave_Architecture);

         Pop_Architecture_Scope (Arch);

         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Translate_Architecture_Body;

      procedure Translate_Component_Configuration_Decl
        (Cfg : Iir; Blk : Iir; Base_Block : Iir; Num : in out Iir_Int32)
      is
         Inter_List : O_Inter_List;
         Comp : Iir_Component_Declaration;
         Comp_Info : Comp_Info_Acc;
         Info : Config_Info_Acc;
         Instance : O_Dnode;
         Mark, Mark2 : Id_Mark_Type;

         Base_Info : Block_Info_Acc;
         Base_Instance : O_Dnode;

         Block : Iir_Block_Configuration;
         Binding : Iir_Binding_Indication;
         Entity_Aspect : Iir;
         Conf_Override : Iir;
         Conf_Info : Config_Info_Acc;
      begin
         --  Incremental binding.
         if Get_Nbr_Elements (Get_Instantiation_List (Cfg)) = 0 then
            --  This component configuration applies to no component
            --  instantiation, so it is not translated.
            return;
         end if;

         Binding := Get_Binding_Indication (Cfg);
         if Binding = Null_Iir then
            --  This is an unbound component configuration, since this is a
            --  no-op, it is not translated.
            return;
         end if;

         Entity_Aspect := Get_Entity_Aspect (Binding);

         Comp := Get_Named_Entity (Get_Component_Name (Cfg));
         Comp_Info := Get_Info (Comp);

         if Get_Kind (Cfg) = Iir_Kind_Component_Configuration then
            Block := Get_Block_Configuration (Cfg);
         else
            Block := Null_Iir;
         end if;

         Push_Identifier_Prefix (Mark, Get_Identifier (Comp), Num);
         Num := Num + 1;

         if Block /= Null_Iir then
            Push_Identifier_Prefix (Mark2, "CONFIG");
            Translate_Configuration_Declaration (Cfg);
            Pop_Identifier_Prefix (Mark2);
            Conf_Override := Cfg;
            Conf_Info := Get_Info (Cfg);
            Clear_Info (Cfg);
         else
            Conf_Info := null;
            Conf_Override := Null_Iir;
         end if;
         Info := Add_Info (Cfg, Kind_Config);

         Base_Info := Get_Info (Base_Block);

         Chap4.Translate_Association_Subprograms
           (Binding, Blk, Base_Block,
            Get_Entity_From_Entity_Aspect (Entity_Aspect));

         Start_Procedure_Decl
           (Inter_List, Create_Identifier, O_Storage_Private);
         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
                             Comp_Info.Comp_Ptr_Type);
         New_Interface_Decl (Inter_List, Base_Instance, Get_Identifier ("BLK"),
                             Base_Info.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Info.Config_Subprg);

         --  Extract the entity/architecture.

         Start_Subprogram_Body (Info.Config_Subprg);
         Push_Local_Factory;

         if Get_Kind (Base_Block) = Iir_Kind_Architecture_Body then
            Push_Architecture_Scope (Base_Block, Base_Instance);
         else
            Push_Scope (Base_Info.Block_Decls_Type, Base_Instance);
         end if;

         Push_Scope (Comp_Info.Comp_Type, Instance);

         if Conf_Info /= null then
            Clear_Info (Cfg);
            Set_Info (Cfg, Conf_Info);
         end if;
         Chap9.Translate_Entity_Instantiation
           (Entity_Aspect, Binding, Comp, Conf_Override);
         if Conf_Info /= null then
            Clear_Info (Cfg);
            Set_Info (Cfg, Info);
         end if;

         Pop_Scope (Comp_Info.Comp_Type);

         if Get_Kind (Base_Block) = Iir_Kind_Architecture_Body then
            Pop_Architecture_Scope (Base_Block);
         else
            Pop_Scope (Base_Info.Block_Decls_Type);
         end if;

         Pop_Local_Factory;
         Finish_Subprogram_Body;

         Pop_Identifier_Prefix (Mark);
      end Translate_Component_Configuration_Decl;

      --  Create subprogram specifications for each configuration_specification
      --  in BLOCK_CONFIG and its sub-blocks.
      --  ARCH is the architecture being configured.
      --  NUM is an integer used to generate uniq names.
      procedure Translate_Block_Configuration_Decls
        (Block_Config : Iir_Block_Configuration;
         Block : Iir;
         Base_Block : Iir;
         Num : in out Iir_Int32)
      is
         El : Iir;
         Mark : Id_Mark_Type;
         Blk : Iir;
         Block_Info : constant Block_Info_Acc := Get_Info (Block);
         Blk_Info : Block_Info_Acc;
      begin
         El := Get_Configuration_Item_Chain (Block_Config);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Component_Configuration
                 | Iir_Kind_Configuration_Specification =>
                  Translate_Component_Configuration_Decl
                    (El, Block, Base_Block, Num);
               when Iir_Kind_Block_Configuration =>
                  Blk := Get_Block_From_Block_Specification
                    (Get_Block_Specification (El));
                  Push_Identifier_Prefix (Mark, Get_Identifier (Blk));
                  Blk_Info := Get_Info (Blk);
                  case Get_Kind (Blk) is
                     when Iir_Kind_Generate_Statement =>
                        Push_Scope_Via_Field_Ptr
                          (Block_Info.Block_Decls_Type,
                           Blk_Info.Block_Origin_Field,
                           Blk_Info.Block_Decls_Type);
                        Translate_Block_Configuration_Decls
                          (El, Blk, Blk, Num);
                        Pop_Scope (Block_Info.Block_Decls_Type);
                     when Iir_Kind_Block_Statement =>
                        Push_Scope (Blk_Info.Block_Decls_Type,
                                    Blk_Info.Block_Parent_Field,
                                    Block_Info.Block_Decls_Type);
                        Translate_Block_Configuration_Decls
                          (El, Blk, Base_Block, Num);
                        Pop_Scope (Blk_Info.Block_Decls_Type);
                     when others =>
                        Error_Kind
                          ("translate_block_configuration_decls(2)", Blk);
                  end case;
                  Pop_Identifier_Prefix (Mark);
               when others =>
                  Error_Kind ("translate_block_configuration_decls(1)", El);
            end case;
            El := Get_Chain (El);
         end loop;
      end Translate_Block_Configuration_Decls;

      procedure Translate_Component_Configuration_Call
        (Cfg : Iir; Base_Block : Iir; Block_Info : Block_Info_Acc)
      is
         Cfg_Info : Config_Info_Acc;
         Base_Info : Block_Info_Acc;
      begin
         if Get_Binding_Indication (Cfg) = Null_Iir then
            --  Unbound component configuration, nothing to do.
            return;
         end if;

         Cfg_Info := Get_Info (Cfg);
         Base_Info := Get_Info (Base_Block);

         --  Call the subprogram for the instantiation list.
         declare
            List : Iir_List;
            El : Iir;
         begin
            List := Get_Instantiation_List (Cfg);
            for I in Natural loop
               El := Get_Nth_Element (List, I);
               exit when El = Null_Iir;
               El := Get_Named_Entity (El);
               case Get_Kind (El) is
                  when Iir_Kind_Component_Instantiation_Statement =>
                     declare
                        Assoc : O_Assoc_List;
                        Info : constant Block_Info_Acc := Get_Info (El);
                        Comp_Info : constant Comp_Info_Acc :=
                          Get_Info (Get_Named_Entity
                                      (Get_Instantiated_Unit (El)));
                        V : O_Lnode;
                     begin
                        --  The component is really a component and not a
                        --  direct instance.
                        Start_Association (Assoc, Cfg_Info.Config_Subprg);
                        V := Get_Instance_Ref (Block_Info.Block_Decls_Type);
                        V := New_Selected_Element (V, Info.Block_Link_Field);
                        New_Association
                          (Assoc, New_Address (V, Comp_Info.Comp_Ptr_Type));
                        V := Get_Instance_Ref (Base_Info.Block_Decls_Type);
                        New_Association
                          (Assoc,
                           New_Address (V, Base_Info.Block_Decls_Ptr_Type));
                        New_Procedure_Call (Assoc);
                     end;
                  when others =>
                     Error_Kind ("translate_component_configuration", El);
               end case;
            end loop;
         end;
      end Translate_Component_Configuration_Call;

      procedure Translate_Block_Configuration_Calls
        (Block_Config : Iir_Block_Configuration;
         Base_Block : Iir;
         Info : Block_Info_Acc);

      procedure Translate_Generate_Block_Configuration_Calls
        (Block_Config : Iir_Block_Configuration;
         Parent_Info : Block_Info_Acc)
      is
         Spec : Iir;
         Block : Iir_Generate_Statement;
         Scheme : Iir;
         Info : Block_Info_Acc;

         --  Generate a call for a iterative generate block whose index is
         --  INDEX.
         --  FAILS is true if it is an error if the block is already
         --  configured.
         procedure Gen_Subblock_Call (Index : O_Enode; Fails : Boolean)
         is
            Var_Inst : O_Dnode;
            If_Blk : O_If_Block;
         begin
            Open_Temp;
            Var_Inst := Create_Temp (Info.Block_Decls_Ptr_Type);
            New_Assign_Stmt
              (New_Obj (Var_Inst),
               New_Address (New_Indexed_Element
                            (New_Acc_Value
                             (New_Selected_Element
                              (Get_Instance_Ref (Parent_Info.Block_Decls_Type),
                               Info.Block_Parent_Field)),
                             Index),
                            Info.Block_Decls_Ptr_Type));
            --  Configure only if not yet configured.
            Start_If_Stmt
              (If_Blk,
               New_Compare_Op (ON_Eq,
                               New_Value_Selected_Acc_Value
                               (New_Obj (Var_Inst),
                                Info.Block_Configured_Field),
                               New_Lit (Ghdl_Bool_False_Node),
                               Ghdl_Bool_Type));
            --  Mark the block as configured.
            New_Assign_Stmt
              (New_Selected_Acc_Value (New_Obj (Var_Inst),
                                       Info.Block_Configured_Field),
               New_Lit (Ghdl_Bool_True_Node));
            Push_Scope (Info.Block_Decls_Type, Var_Inst);
            Push_Scope_Via_Field_Ptr
              (Parent_Info.Block_Decls_Type,
               Info.Block_Origin_Field,
               Info.Block_Decls_Type);
            Translate_Block_Configuration_Calls (Block_Config, Block, Info);
            Pop_Scope (Parent_Info.Block_Decls_Type);
            Pop_Scope (Info.Block_Decls_Type);

            if Fails then
               New_Else_Stmt (If_Blk);
               --  Already configured.
               Chap6.Gen_Program_Error
                 (Block_Config, Chap6.Prg_Err_Block_Configured);
            end if;

            Finish_If_Stmt (If_Blk);
            Close_Temp;
         end Gen_Subblock_Call;

         Type_Info : Type_Info_Acc;
         Iter_Type : Iir;
      begin
         Spec := Get_Block_Specification (Block_Config);
         Block := Get_Block_From_Block_Specification (Spec);
         Info := Get_Info (Block);
         Scheme := Get_Generation_Scheme (Block);
         if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
            Iter_Type := Get_Type (Scheme);
            Type_Info := Get_Info (Get_Base_Type (Iter_Type));
            case Get_Kind (Spec) is
               when Iir_Kind_Generate_Statement
                 | Iir_Kind_Selected_Name =>
                  --  Apply for all/remaining blocks.
                  declare
                     Var_I : O_Dnode;
                     Label : O_Snode;
                  begin
                     Start_Declare_Stmt;
                     New_Var_Decl (Var_I, Wki_I, O_Storage_Local,
                                   Ghdl_Index_Type);
                     Init_Var (Var_I);
                     Start_Loop_Stmt (Label);
                     Gen_Exit_When
                       (Label,
                        New_Compare_Op
                        (ON_Eq,
                         New_Value (New_Obj (Var_I)),
                         New_Value
                         (New_Selected_Element
                          (Get_Var (Get_Info (Iter_Type).T.Range_Var),
                           Type_Info.T.Range_Length)),
                         Ghdl_Bool_Type));
                     --  Selected_name is for default configurations, so
                     --  program should not fail if a block is already
                     --  configured but continue silently.
                     Gen_Subblock_Call
                       (New_Value (New_Obj (Var_I)),
                        Get_Kind (Spec) /= Iir_Kind_Selected_Name);
                     Inc_Var (Var_I);
                     Finish_Loop_Stmt (Label);
                     Finish_Declare_Stmt;
                  end;
               when Iir_Kind_Indexed_Name =>
                  declare
                     Rng : Mnode;
                  begin
                     Open_Temp;
                     Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
                     Gen_Subblock_Call
                       (Chap6.Translate_Index_To_Offset
                        (Rng,
                         Chap7.Translate_Expression
                         (Get_Nth_Element (Get_Index_List (Spec), 0),
                          Iter_Type),
                         Scheme, Iter_Type, Spec),
                        True);
                     Close_Temp;
                  end;
               when Iir_Kind_Slice_Name =>
                  declare
                     Rng : Mnode;
                     Slice : O_Dnode;
                     Slice_Ptr : O_Dnode;
                     Left, Right : O_Dnode;
                     Index : O_Dnode;
                     High : O_Dnode;
                     If_Blk : O_If_Block;
                     Label : O_Snode;
                  begin
                     Open_Temp;
                     Rng := Stabilize (Chap3.Type_To_Range (Iter_Type));
                     Slice := Create_Temp (Type_Info.T.Range_Type);
                     Slice_Ptr := Create_Temp_Ptr
                       (Type_Info.T.Range_Ptr_Type, New_Obj (Slice));
                     Chap7.Translate_Discrete_Range_Ptr
                       (Slice_Ptr, Get_Suffix (Spec));
                     Left := Create_Temp_Init
                       (Ghdl_Index_Type,
                        Chap6.Translate_Index_To_Offset
                        (Rng,
                         New_Value (New_Selected_Element
                                    (New_Obj (Slice), Type_Info.T.Range_Left)),
                         Spec, Iter_Type, Spec));
                     Right := Create_Temp_Init
                       (Ghdl_Index_Type,
                        Chap6.Translate_Index_To_Offset
                        (Rng,
                         New_Value (New_Selected_Element
                                    (New_Obj (Slice),
                                     Type_Info.T.Range_Right)),
                         Spec, Iter_Type, Spec));
                     Index := Create_Temp (Ghdl_Index_Type);
                     High := Create_Temp (Ghdl_Index_Type);
                     Start_If_Stmt
                       (If_Blk,
                        New_Compare_Op (ON_Eq,
                                        M2E (Chap3.Range_To_Dir (Rng)),
                                        New_Value
                                        (New_Selected_Element
                                         (New_Obj (Slice),
                                          Type_Info.T.Range_Dir)),
                                        Ghdl_Bool_Type));
                     --  Same direction, so left to right.
                     New_Assign_Stmt (New_Obj (Index),
                                      New_Value (New_Obj (Left)));
                     New_Assign_Stmt (New_Obj (High),
                                      New_Value (New_Obj (Right)));
                     New_Else_Stmt (If_Blk);
                     --  Opposite direction, so right to left.
                     New_Assign_Stmt (New_Obj (Index),
                                      New_Value (New_Obj (Right)));
                     New_Assign_Stmt (New_Obj (High),
                                      New_Value (New_Obj (Left)));
                     Finish_If_Stmt (If_Blk);

                     --  Loop.
                     Start_Loop_Stmt (Label);
                     Gen_Exit_When
                       (Label, New_Compare_Op (ON_Gt,
                                               New_Value (New_Obj (Index)),
                                               New_Value (New_Obj (High)),
                                               Ghdl_Bool_Type));
                     Open_Temp;
                     Gen_Subblock_Call (New_Value (New_Obj (Index)), True);
                     Close_Temp;
                     Inc_Var (Index);
                     Finish_Loop_Stmt (Label);
                     Close_Temp;
                  end;
               when others =>
                  Error_Kind
                    ("translate_generate_block_configuration_calls", Spec);
            end case;
         else
            --  Conditional generate statement.
            declare
               Var : O_Dnode;
               If_Blk : O_If_Block;
            begin
               --  Configure the block only if it was created.
               Open_Temp;
               Var := Create_Temp_Init
                 (Info.Block_Decls_Ptr_Type,
                  New_Value (New_Selected_Element
                             (Get_Instance_Ref (Parent_Info.Block_Decls_Type),
                              Info.Block_Parent_Field)));
               Start_If_Stmt
                 (If_Blk,
                  New_Compare_Op
                  (ON_Neq,
                   New_Obj_Value (Var),
                   New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)),
                   Ghdl_Bool_Type));
               Push_Scope (Info.Block_Decls_Type, Var);
               Push_Scope_Via_Field_Ptr (Parent_Info.Block_Decls_Type,
                                         Info.Block_Origin_Field,
                                         Info.Block_Decls_Type);
               Translate_Block_Configuration_Calls (Block_Config, Block, Info);
               Pop_Scope (Parent_Info.Block_Decls_Type);
               Pop_Scope (Info.Block_Decls_Type);
               Finish_If_Stmt (If_Blk);
               Close_Temp;
            end;
         end if;
      end Translate_Generate_Block_Configuration_Calls;

      procedure Translate_Block_Configuration_Calls
        (Block_Config : Iir_Block_Configuration;
         Base_Block : Iir;
         Info : Block_Info_Acc)
      is
         El : Iir;
      begin
         El := Get_Configuration_Item_Chain (Block_Config);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Component_Configuration
                 | Iir_Kind_Configuration_Specification =>
                  Translate_Component_Configuration_Call
                    (El, Base_Block, Info);
               when Iir_Kind_Block_Configuration =>
                  declare
                     Block : Iir;
                     Block_Info : Block_Info_Acc;
                  begin
                     Block := Get_Block_Specification (El);
                     if Get_Kind (Block) = Iir_Kind_Block_Statement then
                        Block_Info := Get_Info (Block);
                        Push_Scope (Block_Info.Block_Decls_Type,
                                    Block_Info.Block_Parent_Field,
                                    Info.Block_Decls_Type);
                        Translate_Block_Configuration_Calls
                          (El, Base_Block, Block_Info);
                        Pop_Scope (Block_Info.Block_Decls_Type);
                     else
                        Translate_Generate_Block_Configuration_Calls
                          (El, Info);
                     end if;
                  end;
               when others =>
                  Error_Kind ("translate_block_configuration_calls(2)", El);
            end case;
            El := Get_Chain (El);
         end loop;
      end Translate_Block_Configuration_Calls;

      procedure Translate_Configuration_Declaration (Config : Iir)
      is
         Interface_List : O_Inter_List;
         Block_Config : Iir_Block_Configuration;
         Arch : Iir_Architecture_Body;
         Arch_Info : Block_Info_Acc;
         Config_Info : Config_Info_Acc;
         Instance : O_Dnode;
         Num : Iir_Int32;
         Final : Boolean;
      begin
         if Get_Kind (Config) = Iir_Kind_Configuration_Declaration then
            Chap4.Translate_Declaration_Chain (Config);
         end if;

         Config_Info := Add_Info (Config, Kind_Config);
         Block_Config := Get_Block_Configuration (Config);
         Arch := Get_Block_Specification (Block_Config);
         Arch_Info := Get_Info (Arch);

         --  Configurator.
         Start_Procedure_Decl
           (Interface_List, Create_Identifier, Global_Storage);
         New_Interface_Decl (Interface_List, Instance, Wki_Instance,
                             Arch_Info.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Interface_List, Config_Info.Config_Subprg);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         --  Declare subprograms for configuration.
         Num := 0;
         Translate_Block_Configuration_Decls (Block_Config, Arch, Arch, Num);

         --  Body.
         Start_Subprogram_Body (Config_Info.Config_Subprg);
         Push_Local_Factory;

         Push_Architecture_Scope (Arch, Instance);

         if Get_Kind (Config) = Iir_Kind_Configuration_Declaration then
            Open_Temp;
            Chap4.Elab_Declaration_Chain (Config, Final);
            Close_Temp;
            if Final then
               raise Internal_Error;
            end if;
         end if;

         Translate_Block_Configuration_Calls (Block_Config, Arch, Arch_Info);

         Pop_Architecture_Scope (Arch);
         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Translate_Configuration_Declaration;
   end Chap1;

   package body Chap2 is
      procedure Elab_Package (Spec : Iir_Package_Declaration);

      type Name_String_Xlat_Array is array (Name_Id range <>) of
        String (1 .. 4);
      Operator_String_Xlat : constant
        Name_String_Xlat_Array (Std_Names.Name_Id_Operators) :=
        (Std_Names.Name_Op_Equality => "OPEq",
         Std_Names.Name_Op_Inequality => "OPNe",
         Std_Names.Name_Op_Less => "OPLt",
         Std_Names.Name_Op_Less_Equal => "OPLe",
         Std_Names.Name_Op_Greater => "OPGt",
         Std_Names.Name_Op_Greater_Equal => "OPGe",
         Std_Names.Name_Op_Plus => "OPPl",
         Std_Names.Name_Op_Minus => "OPMi",
         Std_Names.Name_Op_Mul => "OPMu",
         Std_Names.Name_Op_Div => "OPDi",
         Std_Names.Name_Op_Exp => "OPEx",
         Std_Names.Name_Op_Concatenation => "OPCc",
         Std_Names.Name_Op_Condition => "OPCd",
         Std_Names.Name_Op_Match_Equality => "OPQe",
         Std_Names.Name_Op_Match_Inequality => "OPQi",
         Std_Names.Name_Op_Match_Less => "OPQL",
         Std_Names.Name_Op_Match_Less_Equal => "OPQl",
         Std_Names.Name_Op_Match_Greater => "OPQG",
         Std_Names.Name_Op_Match_Greater_Equal => "OPQg");

      --  Set the identifier prefix with the subprogram identifier and
      --  overload number if any.
      procedure Push_Subprg_Identifier (Spec : Iir; Mark : out Id_Mark_Type)
      is
         Id : Name_Id;
      begin
         --  FIXME: name_shift_operators, name_logical_operators,
         --   name_word_operators, name_mod, name_rem
         Id := Get_Identifier (Spec);
         if Id in Std_Names.Name_Id_Operators then
            Push_Identifier_Prefix
              (Mark, Operator_String_Xlat (Id), Get_Overload_Number (Spec));
         else
            Push_Identifier_Prefix (Mark, Id, Get_Overload_Number (Spec));
         end if;
      end Push_Subprg_Identifier;

      procedure Translate_Subprogram_Interfaces (Spec : Iir)
      is
         Inter : Iir;
         Mark : Id_Mark_Type;
      begin
         --  Set the identifier prefix with the subprogram identifier and
         --  overload number if any.
         Push_Subprg_Identifier (Spec, Mark);

         --  Translate interface types.
         Inter := Get_Interface_Declaration_Chain (Spec);
         while Inter /= Null_Iir loop
            Chap3.Translate_Object_Subtype (Inter);
            Inter := Get_Chain (Inter);
         end loop;
         Pop_Identifier_Prefix (Mark);
      end Translate_Subprogram_Interfaces;

      procedure Elab_Subprogram_Interfaces (Spec : Iir)
      is
         Inter : Iir;
      begin
         --  Translate interface types.
         Inter := Get_Interface_Declaration_Chain (Spec);
         while Inter /= Null_Iir loop
            Chap3.Elab_Object_Subtype (Get_Type (Inter));
            Inter := Get_Chain (Inter);
         end loop;
      end Elab_Subprogram_Interfaces;


      --  Return the type of a subprogram interface.
      --  Return O_Tnode_Null if the parameter is passed through the
      --  interface record.
      function Translate_Interface_Type (Inter : Iir) return O_Tnode
      is
         Mode : Object_Kind_Type;
         Tinfo : constant Type_Info_Acc := Get_Info (Get_Type (Inter));
      begin
         case Get_Kind (Inter) is
            when Iir_Kind_Constant_Interface_Declaration
              | Iir_Kind_Variable_Interface_Declaration
              | Iir_Kind_File_Interface_Declaration =>
               Mode := Mode_Value;
            when Iir_Kind_Signal_Interface_Declaration =>
               Mode := Mode_Signal;
            when others =>
               Error_Kind ("translate_interface_type", Inter);
         end case;
         case Tinfo.Type_Mode is
            when Type_Mode_Unknown =>
               raise Internal_Error;
            when Type_Mode_By_Value =>
               return Tinfo.Ortho_Type (Mode);
            when Type_Mode_By_Copy
              | Type_Mode_By_Ref =>
               return Tinfo.Ortho_Ptr_Type (Mode);
         end case;
      end Translate_Interface_Type;

      procedure Translate_Subprogram_Declaration (Spec : Iir)
      is
         Info : constant Subprg_Info_Acc := Get_Info (Spec);
         Is_Func : constant Boolean :=
           Get_Kind (Spec) = Iir_Kind_Function_Declaration;
         Inter : Iir;
         Inter_Type : Iir;
         Arg_Info : Ortho_Info_Acc;
         Tinfo : Type_Info_Acc;
         Interface_List : O_Inter_List;
         Has_Result_Record : Boolean;
         El_List : O_Element_List;
         Mark : Id_Mark_Type;
         Rtype : Iir;
         Id : O_Ident;
         Storage : O_Storage;
         Foreign : Foreign_Info_Type := Foreign_Bad;
      begin
         --  Set the identifier prefix with the subprogram identifier and
         --  overload number if any.
         Push_Subprg_Identifier (Spec, Mark);

         if Get_Foreign_Flag (Spec) then
            --  Special handling for foreign subprograms.
            Foreign := Translate_Foreign_Id (Spec);
            case Foreign.Kind is
               when Foreign_Unknown =>
                  Id := Create_Identifier;
               when Foreign_Intrinsic =>
                  Id := Create_Identifier;
               when Foreign_Vhpidirect =>
                  Id := Get_Identifier
                    (Name_Table.Name_Buffer (Foreign.Subprg_First
                                             .. Foreign.Subprg_Last));
            end case;
            Storage := O_Storage_External;
         else
            Id := Create_Identifier;
            Storage := Global_Storage;
         end if;

         if Is_Func then
            --  If the result of a function is a composite type for ortho,
            --  the result is allocated by the caller and an access to it is
            --  given to the function.
            Rtype := Get_Return_Type (Spec);
            Info.Use_Stack2 := False;
            Tinfo := Get_Info (Rtype);

            if Is_Composite (Tinfo) then
               Start_Procedure_Decl (Interface_List, Id, Storage);
               New_Interface_Decl
                 (Interface_List, Info.Res_Interface,
                  Get_Identifier ("RESULT"),
                  Tinfo.Ortho_Ptr_Type (Mode_Value));
               --  Furthermore, if the result type is unconstrained, the
               --  function will allocate it on a secondary stack.
               if not Is_Fully_Constrained_Type (Rtype) then
                  Info.Use_Stack2 := True;
               end if;
            else
               --  Normal function.
               Start_Function_Decl
                 (Interface_List, Id, Storage, Tinfo.Ortho_Type (Mode_Value));
               Info.Res_Interface := O_Dnode_Null;
            end if;
         else
            --  Create info for each interface of the procedure.
            --  For parameters passed via copy and that needs a copy-out,
            --  gather them in a record.  An access to the record is then
            --  passed to the procedure.
            Has_Result_Record := False;
            Inter := Get_Interface_Declaration_Chain (Spec);
            while Inter /= Null_Iir loop
               Arg_Info := Add_Info (Inter, Kind_Interface);
               Inter_Type := Get_Type (Inter);
               Tinfo := Get_Info (Inter_Type);
               if Get_Kind (Inter) = Iir_Kind_Variable_Interface_Declaration
                 and then Get_Mode (Inter) in Iir_Out_Modes
                 and then Tinfo.Type_Mode not in Type_Mode_By_Ref
                 and then Tinfo.Type_Mode /= Type_Mode_File
               then
                  --  This interface is done via the result record.
                  --  Note: file passed through variables are vhdl87 files,
                  --        which are initialized at elaboration and thus
                  --        behave like an IN parameter.
                  if not Has_Result_Record then
                     --  Create the record.
                     Start_Record_Type (El_List);
                     Has_Result_Record := True;
                  end if;
                  --  Add a field to the record.
                  New_Record_Field (El_List, Arg_Info.Interface_Field,
                                    Create_Identifier_Without_Prefix (Inter),
                                    Tinfo.Ortho_Type (Mode_Value));
               else
                  Arg_Info.Interface_Field := O_Fnode_Null;
               end if;
               Inter := Get_Chain (Inter);
            end loop;
            if Has_Result_Record then
               --  Declare the record type and an access to the record.
               Finish_Record_Type (El_List, Info.Res_Record_Type);
               New_Type_Decl (Create_Identifier ("RESTYPE"),
                              Info.Res_Record_Type);
               Info.Res_Record_Ptr := New_Access_Type (Info.Res_Record_Type);
               New_Type_Decl (Create_Identifier ("RESPTR"),
                              Info.Res_Record_Ptr);
            else
               Info.Res_Interface := O_Dnode_Null;
            end if;

            Start_Procedure_Decl (Interface_List, Id, Storage);

            if Has_Result_Record then
               --  Add the record parameter.
               New_Interface_Decl (Interface_List, Info.Res_Interface,
                                   Get_Identifier ("RESULT"),
                                   Info.Res_Record_Ptr);
            end if;
         end if;

         --  Instance parameter if any.
         if not Get_Foreign_Flag (Spec) then
            Chap2.Create_Subprg_Instance (Interface_List, Spec);
         end if;

         --  Translate interfaces.
         Inter := Get_Interface_Declaration_Chain (Spec);
         while Inter /= Null_Iir loop
            if Is_Func then
               --  Create the info.
               Arg_Info := Add_Info (Inter, Kind_Interface);
               Arg_Info.Interface_Field := O_Fnode_Null;
            else
               --  The info was already created (just above)
               Arg_Info := Get_Info (Inter);
            end if;

            if Arg_Info.Interface_Field = O_Fnode_Null then
               --  Not via the RESULT parameter.
               Arg_Info.Interface_Type := Translate_Interface_Type (Inter);
               New_Interface_Decl
                 (Interface_List, Arg_Info.Interface_Node,
                  Create_Identifier_Without_Prefix (Inter),
                  Arg_Info.Interface_Type);
            end if;
            Inter := Get_Chain (Inter);
         end loop;
         Finish_Subprogram_Decl (Interface_List, Info.Ortho_Func);

         --  Call the hook for foreign subprograms.
         if Get_Foreign_Flag (Spec) and then Foreign_Hook /= null then
            Foreign_Hook.all (Spec, Foreign, Info.Ortho_Func);
         end if;

         Save_Local_Identifier (Info.Subprg_Local_Id);
         Pop_Identifier_Prefix (Mark);
      end Translate_Subprogram_Declaration;

      --  Return TRUE iff subprogram specification SPEC is translated in an
      --  ortho function.
      function Is_Subprogram_Ortho_Function (Spec : Iir) return Boolean
      is
      begin
         if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then
            return False;
         end if;
         if Get_Info (Spec).Res_Interface /= O_Dnode_Null then
            return False;
         end if;
         return True;
      end Is_Subprogram_Ortho_Function;

      --  Return TRUE iif SUBPRG_BODY declares explicitely or implicitely
      --  (or even implicitely by translation) a subprogram.
      function Has_Nested_Subprograms (Subprg_Body : Iir) return Boolean
      is
         Decl : Iir;
         Atype : Iir;
      begin
         Decl := Get_Declaration_Chain (Subprg_Body);
         while Decl /= Null_Iir loop
            case Get_Kind (Decl) is
               when Iir_Kind_Function_Declaration
                 | Iir_Kind_Procedure_Declaration =>
                  return True;
               when Iir_Kind_Function_Body
                 | Iir_Kind_Procedure_Body =>
                  --  The declaration preceed the body.
                  raise Internal_Error;
               when Iir_Kind_Type_Declaration
                 | Iir_Kind_Anonymous_Type_Declaration =>
                  Atype := Get_Type_Definition (Decl);
                  case Iir_Kinds_Type_And_Subtype_Definition
                    (Get_Kind (Atype)) is
                     when Iir_Kinds_Scalar_Type_Definition =>
                        null;
                     when Iir_Kind_Access_Type_Definition
                       | Iir_Kind_Access_Subtype_Definition =>
                        null;
                     when Iir_Kind_File_Type_Definition =>
                        return True;
                     when Iir_Kind_Protected_Type_Declaration =>
                        raise Internal_Error;
                     when Iir_Kinds_Composite_Type_Definition =>
                        --  At least for "=".
                        return True;
                     when Iir_Kind_Incomplete_Type_Definition =>
                        null;
                  end case;
               when others =>
                  null;
            end case;
            Decl := Get_Chain (Decl);
         end loop;
         return False;
      end Has_Nested_Subprograms;

      procedure Translate_Subprogram_Body (Subprg : Iir)
      is
         Spec : constant Iir := Get_Subprogram_Specification (Subprg);
         Info : constant Ortho_Info_Acc := Get_Info (Spec);

         Old_Subprogram : Iir;
         Mark : Id_Mark_Type;
         Final : Boolean;
         Is_Ortho_Func : Boolean;

         --  Set for a public method.  In this case, the lock must be acquired
         --  and retained.
         Is_Prot : Boolean := False;

         --  True if the body has local (nested) subprograms.
         Has_Nested : Boolean;

         Frame_Ptr_Type : O_Tnode;
         Upframe_Field : O_Fnode;

         --  Field in the frame for a pointer to the RESULT structure.
         Res_Field : O_Fnode := O_Fnode_Null;

         Frame : O_Dnode;
         Frame_Ptr : O_Dnode;

         Has_Return : Boolean;

         Prev_Subprg_Instances : Chap2.Subprg_Instance_Stack;
      begin
         --  Do not translate body for foreign subprograms.
         if Get_Foreign_Flag (Spec) then
            return;
         end if;

         --  Check if there are nested subprograms to unnest.  In that case,
         --  a frame record is created, which is less efficient than the
         --  use of local variables.
         if Flag_Unnest_Subprograms then
            Has_Nested := Has_Nested_Subprograms (Subprg);
         else
            Has_Nested := False;
         end if;

         --  Set the identifier prefix with the subprogram identifier and
         --  overload number if any.
         Push_Subprg_Identifier (Spec, Mark);
         Restore_Local_Identifier (Info.Subprg_Local_Id);

         if Has_Nested then
            --  Unnest subprograms.
            --  Create an instance for the local declarations.
            Push_Instance_Factory (O_Tnode_Null);
            Add_Subprg_Instance_Field (Upframe_Field);

            if Info.Res_Record_Ptr /= O_Tnode_Null then
               Res_Field := Add_Instance_Factory_Field
                 (Get_Identifier ("RESULT"), Info.Res_Record_Ptr);
            end if;

            --  Create fields for parameters.
            --  FIXME: do it only if they are referenced in nested
            --  subprograms.
            declare
               Inter : Iir;
               Inter_Info : Inter_Info_Acc;
            begin
               Inter := Get_Interface_Declaration_Chain (Spec);
               while Inter /= Null_Iir loop
                  Inter_Info := Get_Info (Inter);
                  if Inter_Info.Interface_Node /= O_Dnode_Null then
                     Inter_Info.Interface_Field :=
                       Add_Instance_Factory_Field
                       (Create_Identifier_Without_Prefix (Inter),
                        Inter_Info.Interface_Type);
                  end if;
                  Inter := Get_Chain (Inter);
               end loop;
            end;

            Chap4.Translate_Declaration_Chain (Subprg);
            Pop_Instance_Factory (Info.Subprg_Frame_Type);

            New_Type_Decl (Create_Identifier ("_FRAMETYPE"),
                           Info.Subprg_Frame_Type);
            Frame_Ptr_Type := New_Access_Type (Info.Subprg_Frame_Type);
            New_Type_Decl (Create_Identifier ("_FRAMEPTR"), Frame_Ptr_Type);

            Rtis.Generate_Subprogram_Body (Subprg);

            --  Local frame
            Chap2.Push_Subprg_Instance
              (Info.Subprg_Frame_Type, Frame_Ptr_Type,
               Wki_Upframe, Prev_Subprg_Instances);
            --  Link to previous frame
            Chap2.Start_Prev_Subprg_Instance_Use_Via_Field
              (Prev_Subprg_Instances, Upframe_Field);
            --  Result record
            if Info.Res_Record_Ptr /= O_Tnode_Null then
               Chap10.Push_Scope_Via_Field_Ptr
                 (Info.Res_Record_Type, Res_Field, Info.Subprg_Frame_Type);
            end if;

            Chap4.Translate_Declaration_Chain_Subprograms (Subprg, Null_Iir);

            --  Result
            if Info.Res_Record_Ptr /= O_Tnode_Null then
               Chap10.Pop_Scope (Info.Res_Record_Type);
            end if;
            --  Link to previous frame
            Chap2.Finish_Prev_Subprg_Instance_Use_Via_Field
              (Prev_Subprg_Instances, Upframe_Field);
            --  Local frame
            Chap2.Pop_Subprg_Instance (Wki_Upframe, Prev_Subprg_Instances);
         end if;

         --  Create the body

         Start_Subprogram_Body (Info.Ortho_Func);

         Start_Subprg_Instance_Use (Spec);

         if Info.Res_Record_Type /= O_Tnode_Null then
            Push_Scope (Info.Res_Record_Type, Info.Res_Interface);
         end if;

         --  Variables will be created on the stack.
         Push_Local_Factory;

         --  Code has access to local (and outer) variables.
         --  FIXME: this is not necessary if Has_Nested is set
         Chap2.Clear_Subprg_Instance (Prev_Subprg_Instances);

         --  There is a local scope for temporaries.
         Open_Local_Temp;

         --  Init out parameters passed by value/copy.
         declare
            Inter : Iir;
            Inter_Type : Iir;
            Type_Info : Type_Info_Acc;
         begin
            Inter := Get_Interface_Declaration_Chain (Spec);
            while Inter /= Null_Iir loop
               if Get_Kind (Inter) = Iir_Kind_Variable_Interface_Declaration
                 and then Get_Mode (Inter) = Iir_Out_Mode
               then
                  Inter_Type := Get_Type (Inter);
                  Type_Info := Get_Info (Inter_Type);
                  if (Type_Info.Type_Mode in Type_Mode_By_Value
                      or Type_Info.Type_Mode in Type_Mode_By_Copy)
                    and then Type_Info.Type_Mode /= Type_Mode_File
                  then
                     Chap4.Init_Object
                       (Chap6.Translate_Name (Inter), Inter_Type);
                  end if;
               end if;
               Inter := Get_Chain (Inter);
            end loop;
         end;

         if not Has_Nested then
            Chap4.Translate_Declaration_Chain (Subprg);
            Rtis.Generate_Subprogram_Body (Subprg);
            Chap4.Translate_Declaration_Chain_Subprograms (Subprg, Null_Iir);
         else
            New_Var_Decl (Frame, Wki_Frame, O_Storage_Local,
                          Info.Subprg_Frame_Type);
            --  FIXME: Remove this pointer, get a direct access to the frame.
            New_Var_Decl (Frame_Ptr, Get_Identifier ("FRAMEPTR"),
                          O_Storage_Local, Frame_Ptr_Type);
            New_Assign_Stmt (New_Obj (Frame_Ptr),
                             New_Address (New_Obj (Frame), Frame_Ptr_Type));
            Push_Scope (Info.Subprg_Frame_Type, Frame_Ptr);

            --  Set UPFRAME.
            Chap2.Set_Subprg_Instance_Field
              (Frame_Ptr, Upframe_Field, Info.Subprg_Instance);

            if Info.Res_Record_Type /= O_Tnode_Null then
               --  Initialize the RESULT field
               New_Assign_Stmt (New_Selected_Element (New_Obj (Frame),
                                                      Res_Field),
                                New_Obj_Value (Info.Res_Interface));
            end if;

            --  Copy parameter to FRAME.
            declare
               Inter : Iir;
               Inter_Info : Inter_Info_Acc;
            begin
               Inter := Get_Interface_Declaration_Chain (Spec);
               while Inter /= Null_Iir loop
                  Inter_Info := Get_Info (Inter);
                  if Inter_Info.Interface_Node /= O_Dnode_Null then
                     New_Assign_Stmt
                       (New_Selected_Element (New_Obj (Frame),
                                              Inter_Info.Interface_Field),
                        New_Obj_Value (Inter_Info.Interface_Node));

                     --  Forget the reference to the field in FRAME, so that
                     --  this subprogram will directly reference the parameter
                     --  (and not its copy in the FRAME).
                     Inter_Info.Interface_Field := O_Fnode_Null;
                  end if;
                  Inter := Get_Chain (Inter);
               end loop;
            end;
         end if;

         Chap4.Elab_Declaration_Chain (Subprg, Final);

         --  If finalization is required, create a dummy loop around the
         --  body and convert returns into exit out of this loop.
         --  If the subprogram is a function, also create a variable for the
         --  result.
         Is_Prot := Is_Subprogram_Method (Spec);
         if Final or Is_Prot then
            if Is_Prot then
               --  Lock the object.
               Chap3.Call_Ghdl_Protected_Procedure (Get_Method_Type (Spec),
                                                    Ghdl_Protected_Enter);
            end if;
            Is_Ortho_Func := Is_Subprogram_Ortho_Function (Spec);
            if Is_Ortho_Func then
               New_Var_Decl
                 (Info.Subprg_Result, Get_Identifier ("RESULT"),
                  O_Storage_Local,
                  Get_Ortho_Type (Get_Return_Type (Spec), Mode_Value));
            end if;
            Start_Loop_Stmt (Info.Subprg_Exit);
         end if;

         Old_Subprogram := Current_Subprogram;
         Current_Subprogram := Spec;
         Has_Return := Chap8.Translate_Statements_Chain_Has_Return
           (Get_Sequential_Statement_Chain (Subprg));
         Current_Subprogram := Old_Subprogram;

         if Final or Is_Prot then
            --  Create a barrier to catch missing return statement.
            if Get_Kind (Spec) = Iir_Kind_Procedure_Declaration then
               New_Exit_Stmt (Info.Subprg_Exit);
            else
               if not Has_Return then
                  --  Missing return
                  Chap6.Gen_Program_Error
                    (Subprg, Chap6.Prg_Err_Missing_Return);
               end if;
            end if;
            Finish_Loop_Stmt (Info.Subprg_Exit);
            Chap4.Final_Declaration_Chain (Subprg, False);

            if Is_Prot then
               --  Unlock the object.
               Chap3.Call_Ghdl_Protected_Procedure (Get_Method_Type (Spec),
                                                    Ghdl_Protected_Leave);
            end if;
            if Is_Ortho_Func then
               New_Return_Stmt (New_Obj_Value (Info.Subprg_Result));
            end if;
         else
            if Get_Kind (Spec) = Iir_Kind_Function_Declaration
              and then not Has_Return
            then
               --  Missing return
               Chap6.Gen_Program_Error
                 (Subprg, Chap6.Prg_Err_Missing_Return);
            end if;
         end if;

         if Has_Nested then
            Pop_Scope (Info.Subprg_Frame_Type);
         end if;

         Chap2.Pop_Subprg_Instance (O_Ident_Nul, Prev_Subprg_Instances);
         Close_Local_Temp;
         Pop_Local_Factory;

         if Info.Res_Record_Type /= O_Tnode_Null then
            Pop_Scope (Info.Res_Record_Type);
         end if;

         Finish_Subprg_Instance_Use (Spec);

         Finish_Subprogram_Body;

         Pop_Identifier_Prefix (Mark);
      end Translate_Subprogram_Body;

--       procedure Translate_Protected_Subprogram_Declaration
--         (Def : Iir_Protected_Type_Declaration; Spec : Iir; Block : Iir)
--       is
--          Interface_List : O_Inter_List;
--          Info : Subprg_Info_Acc;
--          Tinfo : Type_Info_Acc;
--          Inter : Iir;
--          Inter_Info : Inter_Info_Acc;
--          Prot_Subprg : O_Dnode;
--          Prot_Obj : O_Lnode;
--          Mark : Id_Mark_Type;
--          Constr : O_Assoc_List;
--          Inst_Data : Instance_Data;
--          Is_Func : Boolean;
--          Var_Res : O_Lnode;
--       begin
--          Chap2.Translate_Subprogram_Declaration (Spec, Block);

--          --  Create protected subprogram
--          Info := Get_Info (Spec);
--          Push_Subprg_Identifier (Spec, Info, Mark);

--          Is_Func := Is_Subprogram_Ortho_Function (Spec);

--          if Is_Func then
--             Tinfo := Get_Info (Get_Return_Type (Spec));
--             Start_Function_Decl (Interface_List,
--                                  Create_Identifier ("PROT"),
--                                  Global_Storage,
--                                  Tinfo.Ortho_Type (Mode_Value));
--          else
--             Start_Procedure_Decl (Interface_List,
--                                   Create_Identifier ("PROT"),
--                                   Global_Storage);
--          end if;
--          Chap2.Create_Subprg_Instance (Interface_List, Inst_Data, Block);

--          --  FIXME: RES record interface.

--          New_Interface_Decl
--            (Interface_List,
--             Prot_Obj,
--             Get_Identifier ("OBJ"),
--             Get_Info (Def).Ortho_Ptr_Type (Mode_Value));

--          Inter := Get_Interface_Declaration_Chain (Spec);
--          while Inter /= Null_Iir loop
--             Inter_Info := Get_Info (Inter);
--             if Inter_Info.Interface_Type /= O_Tnode_Null then
--                New_Interface_Decl
--                  (Interface_List, Inter_Info.Interface_Protected,
--                   Create_Identifier_Without_Prefix (Inter),
--                   Inter_Info.Interface_Type);
--             end if;
--             Inter := Get_Chain (Inter);
--          end loop;
--          Finish_Subprogram_Decl (Interface_List, Prot_Subprg);

--          if Global_Storage /= O_Storage_External then
--             --  Body of the protected subprogram.
--             Start_Subprogram_Body (Prot_Subprg);
--             Start_Subprg_Instance_Use (Inst_Data);

--             if Is_Func then
--                New_Var_Decl (Var_Res, Wki_Res, O_Storage_Local,
--                              Tinfo.Ortho_Type (Mode_Value));
--             end if;

--             --  Lock the object.
--             Start_Association (Constr, Ghdl_Protected_Enter);
--             New_Association
--              (Constr, New_Convert_Ov (New_Value (Prot_Obj), Ghdl_Ptr_Type));
--             New_Procedure_Call (Constr);

--             --  Call the unprotected method
--             Start_Association (Constr, Info.Ortho_Func);
--             Add_Subprg_Instance_Assoc (Constr, Inst_Data);
--             New_Association (Constr, New_Value (Prot_Obj));
--             Inter := Get_Interface_Declaration_Chain (Spec);
--             while Inter /= Null_Iir loop
--                Inter_Info := Get_Info (Inter);
--                if Inter_Info.Interface_Type /= O_Tnode_Null then
--                   New_Association
--                     (Constr, New_Value (Inter_Info.Interface_Protected));
--                end if;
--                Inter := Get_Chain (Inter);
--             end loop;
--             if Is_Func then
--                New_Assign_Stmt (Var_Res, New_Function_Call (Constr));
--             else
--                New_Procedure_Call (Constr);
--             end if;

--             --  Unlock the object.
--             Start_Association (Constr, Ghdl_Protected_Leave);
--             New_Association
--              (Constr, New_Convert_Ov (New_Value (Prot_Obj), Ghdl_Ptr_Type));
--             New_Procedure_Call (Constr);

--             if Is_Func then
--                New_Return_Stmt (New_Value (Var_Res));
--             end if;
--             Finish_Subprg_Instance_Use (Inst_Data);
--             Finish_Subprogram_Body;
--          end if;

--          Pop_Identifier_Prefix (Mark);
--       end Translate_Protected_Subprogram_Declaration;

      procedure Translate_Package_Declaration (Decl : Iir_Package_Declaration)
      is
         Info : Ortho_Info_Acc;
         I_List : O_Inter_List;
         --Storage : O_Storage;
      begin
         Chap4.Translate_Declaration_Chain (Decl);
         Chap4.Translate_Declaration_Chain_Subprograms (Decl, Null_Iir);

--          if Chap10.Global_Storage = O_Storage_Public
--            and then not Get_Need_Body (Decl)
--          then
--             Storage := O_Storage_Public;
--          else
--             Storage := O_Storage_External;
--          end if;

         Info := Add_Info (Decl, Kind_Package);

         Start_Procedure_Decl
           (I_List, Create_Identifier ("ELAB_SPEC"), Global_Storage);
         Finish_Subprogram_Decl (I_List, Info.Package_Elab_Spec_Subprg);

         Start_Procedure_Decl
           (I_List, Create_Identifier ("ELAB_BODY"), Global_Storage);
         Finish_Subprogram_Decl (I_List, Info.Package_Elab_Body_Subprg);

         New_Var_Decl (Info.Package_Elab_Var, Create_Identifier ("ELABORATED"),
                       Chap10.Global_Storage, Ghdl_Bool_Type);

         if Flag_Rti then
            Rtis.Generate_Unit (Decl);
         end if;

         if Global_Storage = O_Storage_Public then
            --  Generate RTI.
            Elab_Package (Decl);
         end if;
         Save_Local_Identifier (Info.Package_Local_Id);
      end Translate_Package_Declaration;

      procedure Translate_Package_Body (Decl : Iir_Package_Body)
      is
         Pkg : Iir_Package_Declaration;
      begin
         --  May be called during elaboration to generate RTI.
         if Global_Storage = O_Storage_External then
            return;
         end if;

         Pkg := Get_Package (Decl);
         Restore_Local_Identifier (Get_Info (Pkg).Package_Local_Id);
         Chap4.Translate_Declaration_Chain (Decl);

         if Flag_Rti then
            Rtis.Generate_Unit (Decl);
         end if;

         Chap4.Translate_Declaration_Chain_Subprograms (Decl, Null_Iir);

         Elab_Package_Body (Pkg, Decl);
      end Translate_Package_Body;

      procedure Elab_Package (Spec : Iir_Package_Declaration)
      is
         Info : Ortho_Info_Acc;
         Final : Boolean;
         Constr : O_Assoc_List;
         pragma Unreferenced (Final);
      begin
         Info := Get_Info (Spec);
         Start_Subprogram_Body (Info.Package_Elab_Spec_Subprg);
         Push_Local_Factory;

         Elab_Dependence (Get_Design_Unit (Spec));

         --  Register the package.  This is done dynamically, as we know only
         --  during elaboration that the design depends on a package (a package
         --  maybe referenced by an entity which is never map due to generate
         --  statements).
         Start_Association (Constr, Ghdl_Rti_Add_Package);
         New_Association
           (Constr, New_Lit (Rtis.New_Rti_Address (Info.Package_Rti_Const)));
         New_Procedure_Call (Constr);

         Open_Temp;
         Chap4.Elab_Declaration_Chain (Spec, Final);
         Close_Temp;

         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Elab_Package;

      procedure Elab_Package_Body (Spec : Iir_Package_Declaration; Bod : Iir)
      is
         Info : Ortho_Info_Acc;
         If_Blk : O_If_Block;
         Constr : O_Assoc_List;
         Final : Boolean;
      begin
         Info := Get_Info (Spec);
         Start_Subprogram_Body (Info.Package_Elab_Body_Subprg);
         Push_Local_Factory;

         --  If the package was already elaborated, return now,
         --  else mark the package as elaborated.
         Start_If_Stmt (If_Blk, New_Obj_Value (Info.Package_Elab_Var));
         New_Return_Stmt;
         New_Else_Stmt (If_Blk);
         New_Assign_Stmt (New_Obj (Info.Package_Elab_Var),
                          New_Lit (Ghdl_Bool_True_Node));
         Finish_If_Stmt (If_Blk);

         --  Elab Spec.
         Start_Association (Constr, Info.Package_Elab_Spec_Subprg);
         New_Procedure_Call (Constr);

         if Bod /= Null_Iir then
            Elab_Dependence (Get_Design_Unit (Bod));
            Open_Temp;
            Chap4.Elab_Declaration_Chain (Bod, Final);
            Close_Temp;
         end if;

         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Elab_Package_Body;

      procedure Elab_Dependence (Design_Unit: Iir_Design_Unit)
      is
         Depend_List: Iir_Design_Unit_List;
         Design: Iir;
         Library_Unit: Iir;
         Info : Ortho_Info_Acc;
         If_Blk : O_If_Block;
         Constr : O_Assoc_List;
      begin
         Depend_List := Get_Dependence_List (Design_Unit);

         for I in Natural loop
            Design := Get_Nth_Element (Depend_List, I);
            exit when Design = Null_Iir;
            if Get_Kind (Design) = Iir_Kind_Design_Unit then
               Library_Unit := Get_Library_Unit (Design);
               case Get_Kind (Library_Unit) is
                  when Iir_Kind_Package_Declaration =>
                     if Library_Unit /= Standard_Package then
                        Info := Get_Info (Library_Unit);
                        Start_If_Stmt
                          (If_Blk, New_Monadic_Op
                           (ON_Not, New_Obj_Value (Info.Package_Elab_Var)));
                        -- Elaborates only non-elaborated packages.
                        Start_Association (Constr,
                                           Info.Package_Elab_Body_Subprg);
                        New_Procedure_Call (Constr);
                        Finish_If_Stmt (If_Blk);
                     end if;
                  when Iir_Kind_Entity_Declaration =>
                     --  FIXME: architecture already elaborates its entity.
                     null;
                  when Iir_Kind_Configuration_Declaration =>
                     null;
                  when Iir_Kind_Architecture_Body =>
                     null;
                  when others =>
                     Error_Kind ("elab_dependence", Library_Unit);
               end case;
            end if;
         end loop;
      end Elab_Dependence;

      procedure Clear_Subprg_Instance (Prev : out Subprg_Instance_Stack)
      is
      begin
         Prev := Current_Subprg_Instance;
         Current_Subprg_Instance := Null_Subprg_Instance_Stack;
      end Clear_Subprg_Instance;

      procedure Push_Subprg_Instance (Decl_Type : O_Tnode;
                                      Ptr_Type : O_Tnode;
                                      Ident : O_Ident;
                                      Prev : out Subprg_Instance_Stack)
      is
      begin
         Prev := Current_Subprg_Instance;
         Current_Subprg_Instance := (Decl_Type => Decl_Type,
                                     Ptr_Type => Ptr_Type,
                                     Ident => Ident);
      end Push_Subprg_Instance;

      function Has_Current_Subprg_Instance return Boolean is
      begin
         return Current_Subprg_Instance.Decl_Type /= O_Tnode_Null;
      end Has_Current_Subprg_Instance;

      procedure Pop_Subprg_Instance (Ident : O_Ident;
                                     Prev : Subprg_Instance_Stack)
      is
      begin
         if Is_Equal (Current_Subprg_Instance.Ident, Ident) then
            Current_Subprg_Instance := Prev;
         else
            --  POP does not match with a push.
            raise Internal_Error;
         end if;
      end Pop_Subprg_Instance;

      procedure Add_Subprg_Instance_Interfaces
        (Interfaces : in out O_Inter_List; Vars : out Subprg_Instance_Type)
      is
      begin
         if Has_Current_Subprg_Instance then
            Vars.Inst_Type := Current_Subprg_Instance.Decl_Type;
            Vars.Inter_Type := Current_Subprg_Instance.Ptr_Type;
            New_Interface_Decl
              (Interfaces, Vars.Inter,
               Current_Subprg_Instance.Ident,
               Current_Subprg_Instance.Ptr_Type);
         else
            Vars := Null_Subprg_Instance;
         end if;
      end Add_Subprg_Instance_Interfaces;

      procedure Add_Subprg_Instance_Field (Field : out O_Fnode) is
      begin
         if Has_Current_Subprg_Instance then
            Field := Add_Instance_Factory_Field
              (Current_Subprg_Instance.Ident,
               Current_Subprg_Instance.Ptr_Type);
         else
            Field := O_Fnode_Null;
         end if;
      end Add_Subprg_Instance_Field;

      procedure Add_Subprg_Instance_Assoc
        (Assocs : in out O_Assoc_List; Vars : Subprg_Instance_Type)
      is
         Val : O_Enode;
      begin
         if Vars.Inter /= O_Dnode_Null then
            Val := New_Address (Get_Instance_Ref (Vars.Inst_Type),
                                Vars.Inter_Type);
            New_Association (Assocs, Val);
         end if;
      end Add_Subprg_Instance_Assoc;

      procedure Set_Subprg_Instance_Field
        (Var : O_Dnode; Field : O_Fnode; Vars : Subprg_Instance_Type)
      is
      begin
         if Vars.Inter /= O_Dnode_Null then
            New_Assign_Stmt (New_Selected_Acc_Value (New_Obj (Var), Field),
                             New_Obj_Value (Vars.Inter));
         end if;
      end Set_Subprg_Instance_Field;

      procedure Start_Subprg_Instance_Use (Vars : Subprg_Instance_Type) is
      begin
         if Vars.Inter /= O_Dnode_Null then
            Push_Scope (Vars.Inst_Type, Vars.Inter);
         end if;
      end Start_Subprg_Instance_Use;

      procedure Finish_Subprg_Instance_Use (Vars : Subprg_Instance_Type) is
      begin
         if Vars.Inter /= O_Dnode_Null then
            Pop_Scope (Vars.Inst_Type);
         end if;
      end Finish_Subprg_Instance_Use;

      procedure Start_Prev_Subprg_Instance_Use_Via_Field
        (Prev : Subprg_Instance_Stack; Field : O_Fnode) is
      begin
         if Field /= O_Fnode_Null then
            Push_Scope_Via_Field_Ptr
              (Prev.Decl_Type, Field, Current_Subprg_Instance.Decl_Type);
         end if;
      end Start_Prev_Subprg_Instance_Use_Via_Field;

      procedure Finish_Prev_Subprg_Instance_Use_Via_Field
        (Prev : Subprg_Instance_Stack; Field : O_Fnode) is
      begin
         if Field /= O_Fnode_Null then
            Pop_Scope (Prev.Decl_Type);
         end if;
      end Finish_Prev_Subprg_Instance_Use_Via_Field;

      procedure Create_Subprg_Instance (Interfaces : in out O_Inter_List;
                                        Subprg : Iir)
      is
      begin
         Add_Subprg_Instance_Interfaces
           (Interfaces, Get_Info (Subprg).Subprg_Instance);
      end Create_Subprg_Instance;

      procedure Start_Subprg_Instance_Use (Subprg : Iir) is
      begin
         Start_Subprg_Instance_Use (Get_Info (Subprg).Subprg_Instance);
      end Start_Subprg_Instance_Use;

      procedure Finish_Subprg_Instance_Use (Subprg : Iir) is
      begin
         Finish_Subprg_Instance_Use (Get_Info (Subprg).Subprg_Instance);
      end Finish_Subprg_Instance_Use;
   end Chap2;

   package body Chap3 is
      function Create_Static_Type_Definition_Type_Range (Def : Iir)
        return O_Cnode;
      procedure Create_Scalar_Type_Range (Def : Iir; Target : O_Lnode);

      --  Finish a type definition: declare the type, define and declare a
      --   pointer to the type.
      procedure Finish_Type_Definition
        (Info : Type_Info_Acc; Completion : Boolean := False)
      is
      begin
         --  Declare the type.
         if not Completion then
            New_Type_Decl (Create_Identifier, Info.Ortho_Type (Mode_Value));
         end if;

         --  Create an access to the type and declare it.
         Info.Ortho_Ptr_Type (Mode_Value) :=
           New_Access_Type (Info.Ortho_Type (Mode_Value));
         New_Type_Decl (Create_Identifier ("PTR"),
                        Info.Ortho_Ptr_Type (Mode_Value));

         --  Signal type.
         if Info.Type_Mode in Type_Mode_Scalar then
            Info.Ortho_Type (Mode_Signal) :=
              New_Access_Type (Info.Ortho_Type (Mode_Value));
         end if;
         if Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null then
            New_Type_Decl (Create_Identifier ("SIG"),
                           Info.Ortho_Type (Mode_Signal));
         end if;

         --  Signal pointer type.
         if Info.Type_Mode in Type_Mode_Composite
           and then Info.Ortho_Type (Mode_Signal) /= O_Tnode_Null
         then
            Info.Ortho_Ptr_Type (Mode_Signal) :=
              New_Access_Type (Info.Ortho_Type (Mode_Signal));
            New_Type_Decl (Create_Identifier ("SIGPTR"),
                           Info.Ortho_Ptr_Type (Mode_Signal));
         else
            Info.Ortho_Ptr_Type (Mode_Signal) := O_Tnode_Null;
         end if;
      end Finish_Type_Definition;

      procedure Create_Size_Var (Def : Iir)
      is
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Def);
         Info.C := new Complex_Type_Arr_Info;
         Info.C (Mode_Value).Size_Var := Create_Var
           (Create_Var_Identifier ("SIZE"), Ghdl_Index_Type);
         if Get_Has_Signal_Flag (Def) then
            Info.C (Mode_Signal).Size_Var := Create_Var
              (Create_Var_Identifier ("SIGSIZE"), Ghdl_Index_Type);
         end if;
      end Create_Size_Var;

      --  A builder set internal fields of object pointed by BASE_PTR, using
      --  memory from BASE_PTR and returns a pointer to the next memory byte
      --  to be used.
      procedure Create_Builder_Subprogram_Decl (Info : Type_Info_Acc;
                                                Name : Name_Id;
                                                Kind : Object_Kind_Type)
      is
         Interface_List : O_Inter_List;
         Ident : O_Ident;
         Ptype : O_Tnode;
      begin
         case Kind is
            when Mode_Value =>
               Ident := Create_Identifier (Name, "_BUILDER");
            when Mode_Signal =>
               Ident := Create_Identifier (Name, "_SIGBUILDER");
         end case;
         --  FIXME: return the same type as its first parameter ???
         Start_Function_Decl
           (Interface_List, Ident, Global_Storage, Ghdl_Index_Type);
         Chap2.Add_Subprg_Instance_Interfaces
           (Interface_List, Info.C (Kind).Builder_Instance);
         case Info.Type_Mode is
            when Type_Mode_Fat_Array =>
               Ptype := Info.T.Base_Ptr_Type (Kind);
            when Type_Mode_Record =>
               Ptype := Info.Ortho_Ptr_Type (Kind);
            when others =>
               raise Internal_Error;
         end case;
         New_Interface_Decl
           (Interface_List, Info.C (Kind).Builder_Base_Param,
            Get_Identifier ("base_ptr"), Ptype);
         --  Add parameter for array bounds.
         if Info.Type_Mode = Type_Mode_Fat_Array then
            New_Interface_Decl
              (Interface_List, Info.C (Kind).Builder_Bound_Param,
               Get_Identifier ("bound"), Info.T.Bounds_Ptr_Type);
         end if;
         Finish_Subprogram_Decl (Interface_List, Info.C (Kind).Builder_Func);
      end Create_Builder_Subprogram_Decl;

      function Gen_Call_Type_Builder (Var_Ptr : O_Dnode;
                                      Var_Type : Iir;
                                      Kind : Object_Kind_Type)
        return O_Enode
      is
         Tinfo : Type_Info_Acc;
         Binfo : Type_Info_Acc;
         Assoc : O_Assoc_List;
      begin
         Tinfo := Get_Info (Var_Type);
         --  Build the field
         Binfo := Get_Info (Get_Base_Type (Var_Type));
         Start_Association (Assoc, Binfo.C (Kind).Builder_Func);
         Chap2.Add_Subprg_Instance_Assoc
           (Assoc, Binfo.C (Kind).Builder_Instance);
         case Tinfo.Type_Mode is
            when Type_Mode_Record
              | Type_Mode_Array =>
               New_Association (Assoc, New_Obj_Value (Var_Ptr));
            when Type_Mode_Fat_Array =>
               --  Note: a fat array can only be at the top of a complex type;
               --  the bounds must have been set.
               New_Association
                 (Assoc, New_Value_Selected_Acc_Value
                  (New_Obj (Var_Ptr), Tinfo.T.Base_Field (Kind)));
            when others =>
               raise Internal_Error;
         end case;
         case Tinfo.Type_Mode is
            when Type_Mode_Array =>
               New_Association
                 (Assoc,
                  Get_Array_Bounds_Ptr (O_Lnode_Null, Var_Type, Kind));
            when Type_Mode_Fat_Array =>
               New_Association
                 (Assoc, Get_Array_Ptr_Bounds_Ptr (New_Obj (Var_Ptr),
                                                   Var_Type, Kind));
            when Type_Mode_Record =>
               null;
            when others =>
               raise Internal_Error;
         end case;
         return New_Function_Call (Assoc);
      end Gen_Call_Type_Builder;

      procedure Gen_Call_Type_Builder (Var : Mnode; Var_Type : Iir)
      is
         Mem : O_Dnode;
         V : Mnode;
      begin
         Open_Temp;
         V := Stabilize (Var);
         Mem := Create_Temp (Ghdl_Index_Type);
         New_Assign_Stmt
           (New_Obj (Mem),
            Gen_Call_Type_Builder (M2Dp (V), Var_Type, Get_Object_Kind (Var)));
         Close_Temp;
      end Gen_Call_Type_Builder;

      ------------------
      --  Enumeration --
      ------------------
      function Translate_Enumeration_Literal (Lit : Iir_Enumeration_Literal)
        return O_Ident
      is
         El_Str : String (1 .. 4);
         Id : Name_Id;
         N : Integer;
         C : Character;
      begin
         Id := Get_Identifier (Lit);
         if Name_Table.Is_Character (Id) then
            C := Name_Table.Get_Character (Id);
            El_Str (1) := 'C';
            case C is
               when 'A' .. 'Z'
                 | 'a' .. 'z'
                 | '0' .. '9' =>
                  El_Str (2) := '_';
                  El_Str (3) := C;
               when others =>
                  N := Character'Pos (Name_Table.Get_Character (Id));
                  El_Str (2) := N2hex (N / 16);
                  El_Str (3) := N2hex (N mod 16);
            end case;
            return Get_Identifier (El_Str (1 .. 3));
         else
            return Create_Identifier_Without_Prefix (Lit);
         end if;
      end Translate_Enumeration_Literal;

      procedure Translate_Enumeration_Type
        (Def : Iir_Enumeration_Type_Definition)
      is
         El_List : Iir_List;
         El : Iir_Enumeration_Literal;
         Constr : O_Enum_List;
         Lit_Name : O_Ident;
         Val : O_Cnode;
         Info : Type_Info_Acc;
         Nbr : Natural;
         Size : Natural;
      begin
         El_List := Get_Enumeration_Literal_List (Def);
         Nbr := Get_Nbr_Elements (El_List);
         if Nbr <= 256 then
            Size := 8;
         else
            Size := 32;
         end if;
         Start_Enum_Type (Constr, Size);
         for I in Natural loop
            El := Get_Nth_Element (El_List, I);
            exit when El = Null_Iir;

            Lit_Name := Translate_Enumeration_Literal (El);
            New_Enum_Literal (Constr, Lit_Name, Val);
            Set_Ortho_Expr (El, Val);
         end loop;
         Info := Get_Info (Def);
         Finish_Enum_Type (Constr, Info.Ortho_Type (Mode_Value));
         if Nbr <= 256 then
            Info.Type_Mode := Type_Mode_E8;
         else
            Info.Type_Mode := Type_Mode_E32;
         end if;
         --  Enumerations are always in their range.
         Info.T.Nocheck_Low := True;
         Info.T.Nocheck_Hi := True;
         Finish_Type_Definition (Info);
      end Translate_Enumeration_Type;

      procedure Translate_Bool_Type (Def : Iir_Enumeration_Type_Definition)
      is
         Info : Type_Info_Acc;
         El_List : Iir_List;
         True_Lit, False_Lit : Iir_Enumeration_Literal;
         False_Node, True_Node : O_Cnode;
      begin
         Info := Get_Info (Def);
         El_List := Get_Enumeration_Literal_List (Def);
         if Get_Nbr_Elements (El_List) /= 2 then
            raise Internal_Error;
         end if;
         False_Lit := Get_Nth_Element (El_List, 0);
         True_Lit := Get_Nth_Element (El_List, 1);
         New_Boolean_Type
           (Info.Ortho_Type (Mode_Value),
            Translate_Enumeration_Literal (False_Lit), False_Node,
            Translate_Enumeration_Literal (True_Lit), True_Node);
         Info.Type_Mode := Type_Mode_B2;
         Set_Ortho_Expr (False_Lit, False_Node);
         Set_Ortho_Expr (True_Lit, True_Node);
         Info.T.Nocheck_Low := True;
         Info.T.Nocheck_Hi := True;
         Finish_Type_Definition (Info);
      end Translate_Bool_Type;

      ---------------
      --  Integer  --
      ---------------
      --  Return the number of bits (32 or 64) required to represent the
      --  (integer or physical) type definition DEF.
      type Type_Precision is (Precision_32, Precision_64);
      function Get_Type_Precision (Def : Iir) return Type_Precision
      is
         St : Iir;
         L, H : Iir;
         Lv, Hv : Iir_Int64;
      begin
         St := Get_Subtype_Definition (Get_Type_Declarator (Def));
         Get_Low_High_Limit (Get_Range_Constraint (St), L, H);
         Lv := Get_Value (L);
         Hv := Get_Value (H);
         if Lv >= -(2 ** 31) and then Hv <= (2 ** 31 - 1) then
            return Precision_32;
         else
            if Flag_Only_32b then
               Error_Msg_Sem
                 ("range of " & Disp_Node (Get_Type_Declarator (St))
                  & " is too large", St);
               return Precision_32;
            end if;
            return Precision_64;
         end if;
      end Get_Type_Precision;

      procedure Translate_Integer_Type
        (Def : Iir_Integer_Type_Definition)
      is
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Def);
         case Get_Type_Precision (Def) is
            when Precision_32 =>
               Info.Ortho_Type (Mode_Value) := New_Signed_Type (32);
               Info.Type_Mode := Type_Mode_I32;
            when Precision_64 =>
               Info.Ortho_Type (Mode_Value) := New_Signed_Type (64);
               Info.Type_Mode := Type_Mode_I64;
         end case;
         --  Integers are always in their ranges.
         Info.T.Nocheck_Low := True;
         Info.T.Nocheck_Hi := True;

         Finish_Type_Definition (Info);
      end Translate_Integer_Type;

      ----------------------
      --  Floating types  --
      ----------------------
      procedure Translate_Floating_Type (Def : Iir_Floating_Type_Definition)
      is
         Info : Type_Info_Acc;
      begin
         --  FIXME: should check precision
         Info := Get_Info (Def);
         Info.Type_Mode := Type_Mode_F64;
         Info.Ortho_Type (Mode_Value) := New_Float_Type;
         --  Reals are always in their ranges.
         Info.T.Nocheck_Low := True;
         Info.T.Nocheck_Hi := True;

         Finish_Type_Definition (Info);
      end Translate_Floating_Type;

      ----------------
      --  Physical  --
      ----------------
      procedure Translate_Physical_Type (Def : Iir_Physical_Type_Definition)
      is
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Def);
         case Get_Type_Precision (Def) is
            when Precision_32 =>
               Info.Ortho_Type (Mode_Value) := New_Signed_Type (32);
               Info.Type_Mode := Type_Mode_P32;
            when Precision_64 =>
               Info.Ortho_Type (Mode_Value) := New_Signed_Type (64);
               Info.Type_Mode := Type_Mode_P64;
         end case;
         --  Phyiscals are always in their ranges.
         Info.T.Nocheck_Low := True;
         Info.T.Nocheck_Hi := True;

         Finish_Type_Definition (Info);
      end Translate_Physical_Type;

      procedure Translate_Physical_Units (Def : Iir_Physical_Type_Definition)
      is
         Unit : Iir;
         Info : Object_Info_Acc;
         Phy_Type : O_Tnode;
      begin
         Phy_Type := Get_Ortho_Type (Def, Mode_Value);
         Unit := Get_Unit_Chain (Def);
         while Unit /= Null_Iir loop
            Info := Add_Info (Unit, Kind_Object);
            Info.Object_Var := Create_Var (Create_Var_Identifier (Unit),
                                           Phy_Type);
            Unit := Get_Chain (Unit);
         end loop;
      end Translate_Physical_Units;

      ------------
      --  File  --
      ------------
      procedure Translate_File_Type (Def : Iir_File_Type_Definition)
      is
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Def);
         Info.Ortho_Type (Mode_Value) := Ghdl_File_Index_Type;
         Info.Ortho_Ptr_Type (Mode_Value) := Ghdl_File_Index_Ptr_Type;
         Info.Type_Mode := Type_Mode_File;
      end Translate_File_Type;

      function Get_File_Signature_Length (Def : Iir) return Natural is
      begin
         case Get_Kind (Def) is
            when Iir_Kinds_Scalar_Type_Definition =>
               return 1;
            when Iir_Kind_Array_Type_Definition
              | Iir_Kind_Array_Subtype_Definition =>
               return 2
                 + Get_File_Signature_Length (Get_Element_Subtype (Def));
            when Iir_Kind_Record_Type_Definition
              | Iir_Kind_Record_Subtype_Definition =>
               declare
                  El : Iir;
                  Res : Natural;
                  List : Iir_List;
               begin
                  Res := 2;
                  List := Get_Elements_Declaration_List (Get_Base_Type (Def));
                  for I in Natural loop
                     El := Get_Nth_Element (List, I);
                     exit when El = Null_Iir;
                     Res := Res + Get_File_Signature_Length (Get_Type (El));
                  end loop;
                  return Res;
               end;
            when others =>
               Error_Kind ("get_file_signature_length", Def);
         end case;
      end Get_File_Signature_Length;

      procedure Get_File_Signature (Def : Iir;
                                    Res : in out String;
                                    Off : in out Natural)
      is
         Scalar_Map : constant array (Type_Mode_Scalar) of Character
           := "beEiIpPF";
      begin
         case Get_Kind (Def) is
            when Iir_Kinds_Scalar_Type_Definition =>
               Res (Off) := Scalar_Map (Get_Info (Def).Type_Mode);
               Off := Off + 1;
            when Iir_Kind_Array_Type_Definition
              | Iir_Kind_Array_Subtype_Definition =>
               Res (Off) := '[';
               Off := Off + 1;
               Get_File_Signature (Get_Element_Subtype (Def), Res, Off);
               Res (Off) := ']';
               Off := Off + 1;
            when Iir_Kind_Record_Type_Definition
              | Iir_Kind_Record_Subtype_Definition =>
               declare
                  El : Iir;
                  List : Iir_List;
               begin
                  Res (Off) := '<';
                  Off := Off + 1;
                  List := Get_Elements_Declaration_List (Get_Base_Type (Def));
                  for I in Natural loop
                     El := Get_Nth_Element (List, I);
                     exit when El = Null_Iir;
                     Get_File_Signature (Get_Type (El), Res, Off);
                  end loop;
                  Res (Off) := '>';
                  Off := Off + 1;
               end;
            when others =>
               Error_Kind ("get_file_signature", Def);
         end case;
      end Get_File_Signature;

      procedure Create_File_Type_Var (Def : Iir_File_Type_Definition)
      is
         Type_Name : constant Iir := Get_Type (Get_File_Type_Mark (Def));
         Info : Type_Info_Acc;
      begin
         if Get_Kind (Type_Name) in Iir_Kinds_Scalar_Type_Definition then
            return;
         end if;
         declare
            Len : constant Natural := Get_File_Signature_Length (Type_Name);
            Sig : String (1 .. Len + 2);
            Off : Natural := Sig'First;
         begin
            Get_File_Signature (Type_Name, Sig, Off);
            Sig (Len + 1) := '.';
            Sig (Len + 2) := Character'Val (10);
            Info := Get_Info (Def);
            Info.T.File_Signature := Create_String
              (Sig, Create_Identifier ("FILESIG"), Global_Storage);
         end;
      end Create_File_Type_Var;

      -------------
      --  Array  --
      -------------
      function Type_To_Last_Object_Kind (Def : Iir) return Object_Kind_Type is
      begin
         if Get_Has_Signal_Flag (Def) then
            return Mode_Signal;
         else
            return Mode_Value;
         end if;
      end Type_To_Last_Object_Kind;

      procedure Create_Array_Fat_Pointer
        (Info : Type_Info_Acc; Kind : Object_Kind_Type)
      is
         Constr : O_Element_List;
      begin
         Start_Record_Type (Constr);
         New_Record_Field
           (Constr, Info.T.Base_Field (Kind), Get_Identifier ("BASE"),
            Info.T.Base_Ptr_Type (Kind));
         New_Record_Field
           (Constr, Info.T.Bounds_Field (Kind), Get_Identifier ("BOUNDS"),
            Info.T.Bounds_Ptr_Type);
         Finish_Record_Type (Constr, Info.Ortho_Type (Kind));
      end Create_Array_Fat_Pointer;

      procedure Translate_Incomplete_Array_Type
        (Def : Iir_Array_Type_Definition)
      is
         Arr_Info : Incomplete_Type_Info_Acc;
         Info : Type_Info_Acc;
      begin
         Arr_Info := Get_Info (Def);
         if Arr_Info.Incomplete_Array /= null then
            --  This (incomplete) array type was already translated.
            --  This is the case for a second access type definition to this
            --   still incomplete array type.
            return;
         end if;
         Info := new Ortho_Info_Type (Kind_Type);
         Info.Type_Mode := Type_Mode_Fat_Array;
         Info.Type_Incomplete := True;
         Arr_Info.Incomplete_Array := Info;

         Info.T := Ortho_Info_Type_Array_Init;
         Info.T.Bounds_Type := O_Tnode_Null;

         Info.T.Bounds_Ptr_Type := New_Access_Type (Info.T.Bounds_Type);
         New_Type_Decl (Create_Identifier ("BOUNDP"),
                        Info.T.Bounds_Ptr_Type);

         Info.T.Base_Ptr_Type (Mode_Value) := New_Access_Type (O_Tnode_Null);
         New_Type_Decl (Create_Identifier ("BASEP"),
                        Info.T.Base_Ptr_Type (Mode_Value));

         Create_Array_Fat_Pointer (Info, Mode_Value);

         New_Type_Decl
           (Create_Identifier, Info.Ortho_Type (Mode_Value));
      end Translate_Incomplete_Array_Type;

      procedure Translate_Array_Type_Bounds
        (Def : Iir_Array_Type_Definition;
         Info : Type_Info_Acc;
         Complete : Boolean)
      is
         Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def);
         Constr : O_Element_List;
         Dim : String (1 .. 8);
         N : Natural;
         P : Natural;
         Index : Iir;
         Mark : Id_Mark_Type;
      begin
         Start_Record_Type (Constr);
         Info.T.Bounds_Vector :=
           new O_Fnode_Arr (1 .. Get_Nbr_Elements (Indexes_List));
         for I in Natural loop
            Index := Get_Index_Type (Indexes_List, I);
            exit when Index = Null_Iir;
            if Is_Anonymous_Type_Definition (Index) then
               --  Can this happen ?  This is a type mark.
               Push_Identifier_Prefix (Mark, "DIM", Iir_Int32 (I + 1));
               Translate_Type_Definition (Index, True);
               Pop_Identifier_Prefix (Mark);
               raise Program_Error;
            end if;
            N := I + 1;
            P := Dim'Last;
            loop
               Dim (P) := Character'Val (Character'Pos ('0') + N mod 10);
               P := P - 1;
               N := N / 10;
               exit when N = 0;
            end loop;
            P := P - 3;
            Dim (P .. P + 3) := "dim_";
            New_Record_Field (Constr, Info.T.Bounds_Vector (I + 1),
                              Get_Identifier (Dim (P .. Dim'Last)),
                              Get_Info (Get_Base_Type (Index)).T.Range_Type);
         end loop;
         Finish_Record_Type (Constr, Info.T.Bounds_Type);
         New_Type_Decl (Create_Identifier ("BOUND"),
                        Info.T.Bounds_Type);
         if Complete then
            Finish_Access_Type (Info.T.Bounds_Ptr_Type, Info.T.Bounds_Type);
         else
            Info.T.Bounds_Ptr_Type := New_Access_Type (Info.T.Bounds_Type);
            New_Type_Decl (Create_Identifier ("BOUNDP"),
                           Info.T.Bounds_Ptr_Type);
         end if;
      end Translate_Array_Type_Bounds;

      procedure Translate_Array_Type_Base
        (Def : Iir_Array_Type_Definition;
         Info : Type_Info_Acc;
         Complete : Boolean)
      is
         El_Type : Iir;
         El_Tinfo : Type_Info_Acc;
         Id, Idptr : O_Ident;
      begin
         El_Type := Get_Element_Subtype (Def);
         Translate_Type_Definition (El_Type, True);
         El_Tinfo := Get_Info (El_Type);

         if Is_Complex_Type (El_Tinfo) then
            if El_Tinfo.Type_Mode = Type_Mode_Array then
               Info.T.Base_Type := El_Tinfo.T.Base_Ptr_Type;
               Info.T.Base_Ptr_Type := El_Tinfo.T.Base_Ptr_Type;
            else
               Info.T.Base_Type := El_Tinfo.Ortho_Ptr_Type;
               Info.T.Base_Ptr_Type := El_Tinfo.Ortho_Ptr_Type;
            end if;
         else
            for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
               case Kind is
                  when Mode_Value =>
                     --  For the values.
                     Id := Create_Identifier ("BASE");
                     if not Complete then
                        Idptr := Create_Identifier ("BASEP");
                     else
                        Idptr := O_Ident_Nul;
                     end if;
                  when Mode_Signal =>
                     --  For the signals
                     Id := Create_Identifier ("SIGBASE");
                     Idptr := Create_Identifier ("SIGBASEP");
               end case;
               Info.T.Base_Type (Kind) :=
                 New_Array_Type (El_Tinfo.Ortho_Type (Kind),
                                 Ghdl_Index_Type);
               New_Type_Decl (Id, Info.T.Base_Type (Kind));
               if Is_Equal (Idptr, O_Ident_Nul) then
                  Finish_Access_Type (Info.T.Base_Ptr_Type (Kind),
                                      Info.T.Base_Type (Kind));
               else
                  Info.T.Base_Ptr_Type (Kind) :=
                    New_Access_Type (Info.T.Base_Type (Kind));
                  New_Type_Decl (Idptr, Info.T.Base_Ptr_Type (Kind));
               end if;
            end loop;
         end if;
      end Translate_Array_Type_Base;

      --  For unidimensional arrays: create a constant bounds whose length
      --  is 1, for concatenation with element.
      procedure Translate_Static_Unidimensional_Array_Length_One
        (Def : Iir_Array_Type_Definition)
      is
         Indexes : constant Iir_List := Get_Index_Subtype_List (Def);
         Index_Type : Iir;
         Index_Base_Type : Iir;
         Constr : O_Record_Aggr_List;
         Constr1 : O_Record_Aggr_List;
         Arr_Info : Type_Info_Acc;
         Tinfo : Type_Info_Acc;
         Irange : Iir;
         Res1 : O_Cnode;
         Res : O_Cnode;
      begin
         if Get_Nbr_Elements (Indexes) /= 1 then
            --  Not a one-dimensional array.
            return;
         end if;
         Index_Type := Get_Index_Type (Indexes, 0);
         Arr_Info := Get_Info (Def);
         if Get_Type_Staticness (Index_Type) = Locally then
            if Global_Storage /= O_Storage_External then
               Index_Base_Type := Get_Base_Type (Index_Type);
               Tinfo := Get_Info (Index_Base_Type);
               Irange := Get_Range_Constraint (Index_Type);
               Start_Record_Aggr (Constr, Arr_Info.T.Bounds_Type);
               Start_Record_Aggr (Constr1, Tinfo.T.Range_Type);
               New_Record_Aggr_El
                 (Constr1,
                  Chap7.Translate_Static_Range_Left (Irange, Index_Base_Type));
               New_Record_Aggr_El
                 (Constr1,
                  Chap7.Translate_Static_Range_Left (Irange, Index_Base_Type));
               New_Record_Aggr_El
                 (Constr1, Chap7.Translate_Static_Range_Dir (Irange));
               New_Record_Aggr_El
                 (Constr1, Ghdl_Index_1);
               Finish_Record_Aggr (Constr1, Res1);
               New_Record_Aggr_El (Constr, Res1);
               Finish_Record_Aggr (Constr, Res);
            else
               Res := O_Cnode_Null;
            end if;
            Arr_Info.T.Array_1bound := Create_Global_Const
              (Create_Identifier ("BR1"),
               Arr_Info.T.Bounds_Type, Global_Storage, Res);
         else
            Arr_Info.T.Array_1bound := Create_Var
              (Create_Var_Identifier ("BR1"),
               Arr_Info.T.Bounds_Type, Global_Storage);
         end if;
      end Translate_Static_Unidimensional_Array_Length_One;

      procedure Translate_Dynamic_Unidimensional_Array_Length_One
        (Def : Iir_Array_Type_Definition)
      is
         Indexes : constant Iir_List := Get_Index_Subtype_List (Def);
         Index_Type : Iir;
         Arr_Info : Type_Info_Acc;
         Bound1, Rng : Mnode;
      begin
         if Get_Nbr_Elements (Indexes) /= 1 then
            return;
         end if;
         Index_Type := Get_Index_Type (Indexes, 0);
         if Get_Type_Staticness (Index_Type) = Locally then
            return;
         end if;
         Arr_Info := Get_Info (Def);
         Open_Temp;
         Bound1 := Varv2M (Arr_Info.T.Array_1bound, Arr_Info, Mode_Value,
                           Arr_Info.T.Bounds_Type, Arr_Info.T.Bounds_Ptr_Type);
         Bound1 := Bounds_To_Range (Bound1, Def, 1);
         Stabilize (Bound1);
         Rng := Type_To_Range (Index_Type);
         Stabilize (Rng);
         New_Assign_Stmt (M2Lv (Range_To_Dir (Bound1)),
                          M2E (Range_To_Dir (Rng)));
         New_Assign_Stmt (M2Lv (Range_To_Left (Bound1)),
                          M2E (Range_To_Left (Rng)));
         New_Assign_Stmt (M2Lv (Range_To_Right (Bound1)),
                          M2E (Range_To_Left (Rng)));
         New_Assign_Stmt (M2Lv (Range_To_Length (Bound1)),
                          New_Lit (Ghdl_Index_1));
         Close_Temp;
      end Translate_Dynamic_Unidimensional_Array_Length_One;

      procedure Translate_Array_Type (Def : Iir_Array_Type_Definition)
      is
         Info : Type_Info_Acc;
         El_Tinfo : Type_Info_Acc;
         --  If true, INFO was already partially filled, by a previous access
         --  type definition to this incomplete array type.
         Completion : Boolean;
      begin
         Info := Get_Info (Def);
         Completion := Info.Type_Mode = Type_Mode_Fat_Array;
         if not Completion then
            Info.Type_Mode := Type_Mode_Fat_Array;
            Info.T := Ortho_Info_Type_Array_Init;
         end if;
         Translate_Array_Type_Base (Def, Info, Completion);
         Translate_Array_Type_Bounds (Def, Info, Completion);
         Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
         if not Completion then
            Create_Array_Fat_Pointer (Info, Mode_Value);
         end if;
         if Get_Has_Signal_Flag (Def) then
            Create_Array_Fat_Pointer (Info, Mode_Signal);
         end if;
         Finish_Type_Definition (Info, Completion);

         Translate_Static_Unidimensional_Array_Length_One (Def);

         El_Tinfo := Get_Info (Get_Element_Subtype (Def));
         if Is_Complex_Type (El_Tinfo) then
            --  This is a complex type.
            Info.C := new Complex_Type_Arr_Info;
            --  No size variable for unconstrained array type.
            for Mode in Object_Kind_Type loop
               Info.C (Mode).Size_Var := null;
               Info.C (Mode).Builder_Need_Func :=
                 El_Tinfo.C (Mode).Builder_Need_Func;
            end loop;
         end if;
         Info.Type_Incomplete := False;
      end Translate_Array_Type;

      --  Get the length of DEF, ie the number of elements.
      --  If the length is not statically defined, returns -1.
      function Get_Array_Subtype_Length (Def : Iir_Array_Subtype_Definition)
                                        return Iir_Int64
      is
         Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def);
         Index : Iir;
         Len : Iir_Int64;
      begin
         --  Check if the bounds of the array are locally static.
         Len := 1;
         for I in Natural loop
            Index := Get_Index_Type (Indexes_List, I);
            exit when Index = Null_Iir;

            if Get_Type_Staticness (Index) /= Locally then
               return -1;
            end if;
            Len := Len * Eval_Discrete_Type_Length (Index);
         end loop;
         return Len;
      end Get_Array_Subtype_Length;

      procedure Translate_Array_Subtype (Def : Iir_Array_Subtype_Definition)
      is
         Info : Type_Info_Acc;
         Binfo : Type_Info_Acc;

         Len : Iir_Int64;

         Id : O_Ident;
      begin
         Info := Get_Info (Def);
         Binfo := Get_Info (Get_Base_Type (Def));

         --  Note: info of indexes subtype are not created!

         Len := Get_Array_Subtype_Length (Def);
         Info.Type_Mode := Type_Mode_Array;
         Info.Type_Locally_Constrained := (Len >= 0);
         if Is_Complex_Type (Binfo)
           or else not Info.Type_Locally_Constrained
         then
            --  This is a complex type as the size is not known at compile
            --  time.
            Info.Ortho_Type := Binfo.T.Base_Ptr_Type;
            Info.Ortho_Ptr_Type := Binfo.T.Base_Ptr_Type;

            Create_Size_Var (Def);

            for Mode in Object_Kind_Type loop
               Info.C (Mode).Builder_Need_Func :=
                 Is_Complex_Type (Binfo)
                 and then Binfo.C (Mode).Builder_Need_Func;
            end loop;
         else
            --  Length is known.  Create a constrained array.
            Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
            Info.Ortho_Ptr_Type := Binfo.T.Base_Ptr_Type;
            for I in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
               case I is
                  when Mode_Value =>
                     Id := Create_Identifier;
                  when Mode_Signal =>
                     Id := Create_Identifier ("SIG");
               end case;
               Info.Ortho_Type (I) := New_Constrained_Array_Type
                 (Binfo.T.Base_Type (I),
                  New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Len)));
               New_Type_Decl (Id, Info.Ortho_Type (I));
            end loop;
         end if;
      end Translate_Array_Subtype;

      function Create_Static_Array_Subtype_Bounds
        (Def : Iir_Array_Subtype_Definition)
        return O_Cnode
      is
         Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def);
         Baseinfo : constant Type_Info_Acc := Get_Info (Get_Base_Type (Def));
         Index : Iir;
         List : O_Record_Aggr_List;
         Res : O_Cnode;
      begin
         Start_Record_Aggr (List, Baseinfo.T.Bounds_Type);
         for I in Natural loop
            Index := Get_Index_Type (Indexes_List, I);
            exit when Index = Null_Iir;
            New_Record_Aggr_El
              (List, Create_Static_Type_Definition_Type_Range (Index));
         end loop;
         Finish_Record_Aggr (List, Res);
         return Res;
      end Create_Static_Array_Subtype_Bounds;

      procedure Create_Array_Subtype_Bounds
        (Def : Iir_Array_Subtype_Definition; Target : O_Lnode)
      is
         Baseinfo : constant Type_Info_Acc := Get_Info (Get_Base_Type (Def));
         Indexes_List : constant Iir_List := Get_Index_Subtype_List (Def);
         Index : Iir;
         Targ : Mnode;
      begin
         Targ := Lv2M (Target, True,
                       Baseinfo.T.Bounds_Type,
                       Baseinfo.T.Bounds_Ptr_Type,
                       null, Mode_Value);
         Open_Temp;
         if Get_Nbr_Elements (Indexes_List) > 1 then
            Targ := Stabilize (Targ);
         end if;
         for I in Natural loop
            Index := Get_Index_Type (Indexes_List, I);
            exit when Index = Null_Iir;
            declare
               Index_Type : constant Iir := Get_Base_Type (Index);
               Index_Info : constant Type_Info_Acc := Get_Info (Index_Type);
               D : O_Dnode;
            begin
               Open_Temp;
               D := Create_Temp_Ptr
                 (Index_Info.T.Range_Ptr_Type,
                  New_Selected_Element (M2Lv (Targ),
                                        Baseinfo.T.Bounds_Vector (I + 1)));
               Chap7.Translate_Discrete_Range_Ptr (D, Index);
               Close_Temp;
            end;
         end loop;
         Close_Temp;
      end Create_Array_Subtype_Bounds;

      --  Get staticness of the array bounds.
      function Get_Array_Bounds_Staticness (Def : Iir) return Iir_Staticness
      is
         List : constant Iir_List := Get_Index_Subtype_List (Def);
         Idx_Type : Iir;
      begin
         for I in Natural loop
            Idx_Type := Get_Index_Type (List, I);
            exit when Idx_Type = Null_Iir;
            if Get_Type_Staticness (Idx_Type) /= Locally then
               return Globally;
            end if;
         end loop;
         return Locally;
      end Get_Array_Bounds_Staticness;

      --  Create a variable containing the bounds for array subtype DEF.
      procedure Create_Array_Subtype_Bounds_Var
        (Def : Iir; Elab_Now : Boolean)
      is
         Info : Type_Info_Acc;
         Base_Info : Type_Info_Acc;
         Val : O_Cnode;
      begin
         Info := Get_Info (Def);
         if Info.T.Array_Bounds /= null then
            return;
         end if;
         Base_Info := Get_Info (Get_Base_Type (Def));
         case Get_Array_Bounds_Staticness (Def) is
            when None
              | Globally =>
               Info.T.Static_Bounds := False;
               Info.T.Array_Bounds := Create_Var
                 (Create_Var_Identifier ("STB"), Base_Info.T.Bounds_Type);
               if Elab_Now then
                  Create_Array_Subtype_Bounds
                    (Def, Get_Var (Info.T.Array_Bounds));
               end if;
            when Locally =>
               Info.T.Static_Bounds := True;
               if Global_Storage = O_Storage_External then
                  --  Do not create the value of the type desc, since it
                  --  is never dereferenced in a static type desc.
                  Val := O_Cnode_Null;
               else
                  Val := Create_Static_Array_Subtype_Bounds (Def);
               end if;
               Info.T.Array_Bounds := Create_Global_Const
                 (Create_Identifier ("STB"),
                  Base_Info.T.Bounds_Type, Global_Storage, Val);

            when Unknown =>
               raise Internal_Error;
         end case;
      end Create_Array_Subtype_Bounds_Var;

      procedure Create_Array_Type_Builder
        (Def : Iir_Array_Type_Definition; Kind : Object_Kind_Type)
      is
         Info : constant Type_Info_Acc := Get_Info (Def);
         Base : constant O_Dnode := Info.C (Kind).Builder_Base_Param;
         Bound : constant O_Dnode := Info.C (Kind).Builder_Bound_Param;
         Var_Off : O_Dnode;
         Var_Mem : O_Dnode;
         Var_Length : O_Dnode;
         El_Type : Iir;
         El_Info : Type_Info_Acc;
         Label : O_Snode;
      begin
         Start_Subprogram_Body (Info.C (Kind).Builder_Func);
         Chap2.Start_Subprg_Instance_Use (Info.C (Kind).Builder_Instance);

         --  Compute length of the array.
         New_Var_Decl (Var_Length, Wki_Length, O_Storage_Local,
                       Ghdl_Index_Type);
         New_Var_Decl (Var_Mem, Get_Identifier ("mem"), O_Storage_Local,
                       Info.T.Base_Ptr_Type (Kind));
         New_Var_Decl (Var_Off, Get_Identifier ("off"), O_Storage_Local,
                       Ghdl_Index_Type);

         El_Type := Get_Element_Subtype (Def);
         El_Info := Get_Info (El_Type);

         New_Assign_Stmt
           (New_Obj (Var_Length),
            New_Dyadic_Op (ON_Mul_Ov,
                           New_Value (Get_Var (El_Info.C (Kind).Size_Var)),
                           Get_Bounds_Ptr_Length (Bound, Def)));

         --  Find the innermost non-array element.
         while El_Info.Type_Mode = Type_Mode_Array loop
            El_Type := Get_Element_Subtype (El_Type);
            El_Info := Get_Info (El_Type);
         end loop;

         --  Set each index of the array.
         Init_Var (Var_Off);
         Start_Loop_Stmt (Label);
         Gen_Exit_When (Label,
                        New_Compare_Op (ON_Eq,
                                        New_Obj_Value (Var_Off),
                                        New_Obj_Value (Var_Length),
                                        Ghdl_Bool_Type));

         New_Assign_Stmt
           (New_Obj (Var_Mem),
            New_Unchecked_Address
              (New_Slice (New_Access_Element
                            (New_Convert_Ov (New_Obj_Value (Base),
                                             Char_Ptr_Type)),
                          Chararray_Type,
                          New_Obj_Value (Var_Off)),
               Info.T.Base_Ptr_Type (Kind)));

         New_Assign_Stmt
           (New_Obj (Var_Off),
            New_Dyadic_Op (ON_Add_Ov,
                           New_Obj_Value (Var_Off),
                           Gen_Call_Type_Builder (Var_Mem, El_Type, Kind)));
         Finish_Loop_Stmt (Label);

         New_Return_Stmt (New_Obj_Value (Var_Off));

         Chap2.Finish_Subprg_Instance_Use (Info.C (Kind).Builder_Instance);
         Finish_Subprogram_Body;
      end Create_Array_Type_Builder;

      --------------
      --  record  --
      --------------

      --  Get the alignment mask for *ortho* type ATYPE.
      function Get_Type_Alignmask (Atype : O_Tnode) return O_Enode is
      begin
         return New_Dyadic_Op
           (ON_Sub_Ov,
            New_Lit (New_Alignof (Atype, Ghdl_Index_Type)),
            New_Lit (Ghdl_Index_1));
      end Get_Type_Alignmask;

      --  Get the alignment mask for type INFO (Mode_Value).
      function Get_Type_Alignmask (Info : Type_Info_Acc) return O_Enode is
      begin
         if Is_Complex_Type (Info) then
            if Info.Type_Mode /= Type_Mode_Record then
               raise Internal_Error;
            end if;
            return New_Value (Get_Var (Info.C (Mode_Value).Align_Var));
         else
            return Get_Type_Alignmask (Info.Ortho_Type (Mode_Value));
         end if;
      end Get_Type_Alignmask;

      --  Align VALUE (of unsigned type) for type ATYPE.
      --  The formulae is: (V + (A - 1)) and not (A - 1), where A is the
      --  alignment for ATYPE in bytes.
      function Realign (Value : O_Enode; Atype : Iir) return O_Enode
      is
         Tinfo : constant Type_Info_Acc := Get_Info (Atype);
      begin
         return New_Dyadic_Op
           (ON_And,
            New_Dyadic_Op (ON_Add_Ov, Value, Get_Type_Alignmask (Tinfo)),
            New_Monadic_Op (ON_Not, Get_Type_Alignmask (Tinfo)));
      end Realign;

      function Realign (Value : O_Enode; Mask : O_Dnode) return O_Enode is
      begin
         return New_Dyadic_Op
           (ON_And,
            New_Dyadic_Op (ON_Add_Ov, Value, New_Obj_Value (Mask)),
            New_Monadic_Op (ON_Not, New_Obj_Value (Mask)));
      end Realign;

      --  Find the innermost non-array element.
      function Get_Innermost_Non_Array_Element (Atype : Iir) return Iir
      is
         Res : Iir := Atype;
      begin
         while Get_Kind (Res) in Iir_Kinds_Array_Type_Definition loop
            Res := Get_Element_Subtype (Res);
         end loop;
         return Res;
      end Get_Innermost_Non_Array_Element;

      procedure Translate_Record_Type (Def : Iir_Record_Type_Definition)
      is
         El_List : O_Element_List;
         List : Iir_List;
         El : Iir_Element_Declaration;
         Info : Type_Info_Acc;
         Field_Info : Ortho_Info_Acc;
         El_Type : Iir;
         El_Tinfo : Type_Info_Acc;
         El_Tnode : O_Tnode;

         --  True if a size variable will be created since the size of
         --  the record is not known at compile-time.
         Need_Size : Boolean;

         Mark : Id_Mark_Type;
      begin
         Info := Get_Info (Def);
         Need_Size := False;
         List := Get_Elements_Declaration_List (Def);

         --  First, translate the anonymous type of the elements.
         for I in Natural loop
            El := Get_Nth_Element (List, I);
            exit when El = Null_Iir;
            El_Type := Get_Type (El);
            if Get_Info (El_Type) = null then
               Push_Identifier_Prefix (Mark, Get_Identifier (El));
               Translate_Type_Definition (El_Type);
               Pop_Identifier_Prefix (Mark);
            end if;
            if not Need_Size and then Is_Complex_Type (Get_Info (El_Type)) then
               Need_Size := True;
            end if;
            Field_Info := Add_Info (El, Kind_Field);
         end loop;

         --  Then create the record type.
         Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
         for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
            Start_Record_Type (El_List);
            for I in Natural loop
               El := Get_Nth_Element (List, I);
               exit when El = Null_Iir;
               Field_Info := Get_Info (El);
               El_Tinfo := Get_Info (Get_Type (El));
               if Is_Complex_Type (El_Tinfo) then
                  --  Always use an offset for a complex type.
                  El_Tnode := Ghdl_Index_Type;
               else
                  El_Tnode := El_Tinfo.Ortho_Type (Kind);
               end if;

               New_Record_Field (El_List, Field_Info.Field_Node (Kind),
                                 Create_Identifier_Without_Prefix (El),
                                 El_Tnode);
            end loop;
            Finish_Record_Type (El_List, Info.Ortho_Type (Kind));
         end loop;
         Info.Type_Mode := Type_Mode_Record;
         Finish_Type_Definition (Info);

         if Need_Size then
            Create_Size_Var (Def);
            Info.C (Mode_Value).Align_Var := Create_Var
              (Create_Var_Identifier ("ALIGNMSK"), Ghdl_Index_Type);
            Info.C (Mode_Value).Builder_Need_Func := True;
            Info.C (Mode_Signal).Builder_Need_Func := True;
         end if;
      end Translate_Record_Type;

      procedure Create_Record_Type_Builder
        (Def : Iir_Record_Type_Definition; Kind : Object_Kind_Type)
      is
         Info : constant Type_Info_Acc := Get_Info (Def);
         Base : constant O_Dnode := Info.C (Kind).Builder_Base_Param;
         List : Iir_List;
         El : Iir_Element_Declaration;

         Off_Var : O_Dnode;
         Ptr_Var : O_Dnode;
         Off_Val : O_Enode;
         El_Type : Iir;
         Inner_Type : Iir;
         El_Tinfo : Type_Info_Acc;
      begin
         Start_Subprogram_Body (Info.C (Kind).Builder_Func);
         Chap2.Start_Subprg_Instance_Use (Info.C (Kind).Builder_Instance);

         New_Var_Decl (Off_Var, Get_Identifier ("off"), O_Storage_Local,
                       Ghdl_Index_Type);

         --  Reserve memory for the record, ie:
         --  OFF = SIZEOF (record).
         New_Assign_Stmt
           (New_Obj (Off_Var),
            New_Lit (New_Sizeof (Info.Ortho_Type (Kind),
                                 Ghdl_Index_Type)));

         --  Set memory for each complex element.
         List := Get_Elements_Declaration_List (Def);
         for I in Natural loop
            El := Get_Nth_Element (List, I);
            exit when El = Null_Iir;
            El_Type := Get_Type (El);
            El_Tinfo := Get_Info (El_Type);
            if Is_Complex_Type (El_Tinfo) then
               --  Complex type.

               --  Align on the innermost array element (which should be
               --  a record) for Mode_Value.  No need to align for signals,
               --  as all non-composite elements are accesses.
               Inner_Type := Get_Innermost_Non_Array_Element (El_Type);
               Off_Val := New_Obj_Value (Off_Var);
               if Kind = Mode_Value then
                  Off_Val := Realign (Off_Val, Inner_Type);
               end if;
               New_Assign_Stmt (New_Obj (Off_Var), Off_Val);

               --  Set the offset.
               New_Assign_Stmt
                 (New_Selected_Element (New_Acc_Value (New_Obj (Base)),
                                        Get_Info (El).Field_Node (Kind)),
                  New_Obj_Value (Off_Var));

               if El_Tinfo.C (Kind).Builder_Need_Func then
                  --  This type needs a builder, call it.
                  Start_Declare_Stmt;
                  New_Var_Decl
                    (Ptr_Var, Get_Identifier ("var_ptr"),
                     O_Storage_Local, El_Tinfo.Ortho_Ptr_Type (Kind));

                  New_Assign_Stmt
                    (New_Obj (Ptr_Var),
                     M2E (Chap6.Translate_Selected_Element
                            (Dp2M (Base, Info, Kind), El)));

                  New_Assign_Stmt
                    (New_Obj (Off_Var),
                     New_Dyadic_Op (ON_Add_Ov,
                                    New_Obj_Value (Off_Var),
                                    Gen_Call_Type_Builder
                                      (Ptr_Var, El_Type, Kind)));

                  Finish_Declare_Stmt;
               else
                  --  Allocate memory.
                  New_Assign_Stmt
                    (New_Obj (Off_Var),
                     New_Dyadic_Op
                       (ON_Add_Ov,
                        New_Obj_Value (Off_Var),
                        New_Value (Get_Var (El_Tinfo.C (Kind).Size_Var))));
               end if;
            end if;
         end loop;
         New_Return_Stmt (New_Value (Get_Var (Info.C (Kind).Size_Var)));
         Chap2.Finish_Subprg_Instance_Use (Info.C (Kind).Builder_Instance);
         Finish_Subprogram_Body;
      end Create_Record_Type_Builder;

      --------------
      --  Access  --
      --------------
      procedure Translate_Access_Type (Def : Iir_Access_Type_Definition)
      is
         D_Type : constant Iir := Get_Designated_Type (Def);
         D_Info : constant Ortho_Info_Acc := Get_Info (D_Type);
         Def_Info : constant Type_Info_Acc := Get_Info (Def);
         Dtype : O_Tnode;
         Arr_Info : Type_Info_Acc;
      begin
         if not Is_Fully_Constrained_Type (D_Type) then
            --  An access type to an unconstrained type definition is a fat
            --  pointer.
            Def_Info.Type_Mode := Type_Mode_Fat_Acc;
            if D_Info.Kind = Kind_Incomplete_Type then
               Translate_Incomplete_Array_Type (D_Type);
               Arr_Info := D_Info.Incomplete_Array;
               Def_Info.Ortho_Type := Arr_Info.Ortho_Type;
               Def_Info.T := Arr_Info.T;
            else
               Def_Info.Ortho_Type := D_Info.Ortho_Type;
               Def_Info.T := D_Info.T;
            end if;
            Def_Info.Ortho_Ptr_Type (Mode_Value) :=
              New_Access_Type (Def_Info.Ortho_Type (Mode_Value));
            New_Type_Decl (Create_Identifier ("PTR"),
                           Def_Info.Ortho_Ptr_Type (Mode_Value));
         else
            --  Otherwise, it is a thin pointer.
            Def_Info.Type_Mode := Type_Mode_Acc;
            --  No access types for signals.
            Def_Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;

            if D_Info.Kind = Kind_Incomplete_Type then
               Dtype := O_Tnode_Null;
            elsif Is_Complex_Type (D_Info) then
               --  FIXME: clean here when the ortho_type of a array
               --  complex_type is correctly set (not a pointer).
               Def_Info.Ortho_Type (Mode_Value) :=
                 D_Info.Ortho_Ptr_Type (Mode_Value);
               Finish_Type_Definition (Def_Info, True);
               return;
            elsif D_Info.Type_Mode in Type_Mode_Arrays then
               --  The designated type cannot be a sub array inside ortho.
               --  FIXME: lift this restriction.
               Dtype := D_Info.T.Base_Type (Mode_Value);
            else
               Dtype := D_Info.Ortho_Type (Mode_Value);
            end if;
            Def_Info.Ortho_Type (Mode_Value) := New_Access_Type (Dtype);
            Finish_Type_Definition (Def_Info);
         end if;
      end Translate_Access_Type;

      ------------------------
      --  Incomplete types  --
      ------------------------
      procedure Translate_Incomplete_Type (Def : Iir)
      is
--         Ftype : Iir;
--         Info : Type_Info_Acc;
         Info : Incomplete_Type_Info_Acc;
         Ctype : Iir;
      begin
         if Get_Nbr_Elements (Get_Incomplete_Type_List (Def)) = 0 then
            --  FIXME:
            --  This is a work-around for dummy incomplete type (ie incomplete
            --  types not used before the full type declaration).
            return;
         end if;
         Ctype := Get_Type (Get_Type_Declarator (Def));
         Info := Add_Info (Ctype, Kind_Incomplete_Type);
         Info.Incomplete_Type := Def;
         Info.Incomplete_Array := null;
      end Translate_Incomplete_Type;

      --  CTYPE is the type which has been completed.
      procedure Translate_Complete_Type
        (Incomplete_Info : in out Incomplete_Type_Info_Acc; Ctype : Iir)
      is
         List : Iir_List;
         Atype : Iir;
         Def_Info : Type_Info_Acc;
         C_Info : Type_Info_Acc;
         Dtype : O_Tnode;
      begin
         C_Info := Get_Info (Ctype);
         List := Get_Incomplete_Type_List (Incomplete_Info.Incomplete_Type);
         for I in Natural loop
            Atype := Get_Nth_Element (List, I);
            exit when Atype = Null_Iir;
            if Get_Kind (Atype) /= Iir_Kind_Access_Type_Definition then
               raise Internal_Error;
            end if;
            Def_Info := Get_Info (Atype);
            case C_Info.Type_Mode is
               when Type_Mode_Arrays =>
                  Dtype := C_Info.T.Base_Type (Mode_Value);
               when others =>
                  Dtype := C_Info.Ortho_Type (Mode_Value);
            end case;
            Finish_Access_Type (Def_Info.Ortho_Type (Mode_Value), Dtype);
         end loop;
         Unchecked_Deallocation (Incomplete_Info);
      end Translate_Complete_Type;

      -----------------
      --  protected  --
      -----------------
      procedure Translate_Protected_Type (Def : Iir_Protected_Type_Declaration)
      is
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Def);

         New_Uncomplete_Record_Type (Info.Ortho_Type (Mode_Value));
         New_Type_Decl (Create_Identifier, Info.Ortho_Type (Mode_Value));

         Info.Ortho_Ptr_Type (Mode_Value) :=
           New_Access_Type (Info.Ortho_Type (Mode_Value));
         New_Type_Decl (Create_Identifier ("PTR"),
                        Info.Ortho_Ptr_Type (Mode_Value));

         Info.Ortho_Type (Mode_Signal) := O_Tnode_Null;
         Info.Ortho_Ptr_Type (Mode_Signal) := O_Tnode_Null;

         Info.Type_Mode := Type_Mode_Protected;

         --  A protected type is a complex type, as its size is not known
         --  at definition point (will be known at body declaration).
         Info.C := new Complex_Type_Arr_Info;
         Info.C (Mode_Value).Builder_Need_Func := False;

         --  This is just use to set overload number on subprograms, and to
         --  translate interfaces.
         Chap4.Translate_Declaration_Chain (Def);
      end Translate_Protected_Type;

      procedure Translate_Protected_Type_Subprograms
        (Def : Iir_Protected_Type_Declaration)
      is
         El : Iir;
         Info : Type_Info_Acc;
         Inter_List : O_Inter_List;
         Mark : Id_Mark_Type;
         Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
      begin
         Push_Identifier_Prefix
           (Mark, Get_Identifier (Get_Type_Declarator (Def)));

         Info := Get_Info (Def);

         --  Init.
         Start_Function_Decl
           (Inter_List, Create_Identifier ("INIT"), Global_Storage,
            Info.Ortho_Ptr_Type (Mode_Value));
         Chap2.Add_Subprg_Instance_Interfaces
           (Inter_List, Info.T.Prot_Init_Instance);
         Finish_Subprogram_Decl (Inter_List, Info.T.Prot_Init_Subprg);

         --  Use the object as instance.
         Chap2.Push_Subprg_Instance (Info.Ortho_Type (Mode_Value),
                                     Info.Ortho_Ptr_Type (Mode_Value),
                                     Wki_Obj,
                                     Prev_Subprg_Instance);

         --  Final.
         Start_Procedure_Decl
           (Inter_List, Create_Identifier ("FINI"), Global_Storage);
         Chap2.Add_Subprg_Instance_Interfaces
           (Inter_List, Info.T.Prot_Final_Instance);
         Finish_Subprogram_Decl (Inter_List, Info.T.Prot_Final_Subprg);

         --  Methods.
         El := Get_Declaration_Chain (Def);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Function_Declaration
                 | Iir_Kind_Procedure_Declaration =>
                  --  Translate only if used.
                  if Get_Info (El) /= null then
                     Chap2.Translate_Subprogram_Declaration (El);
                  end if;
               when others =>
                  Error_Kind ("translate_protected_type_subprograms", El);
            end case;
            El := Get_Chain (El);
         end loop;

         Chap2.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance);

         Pop_Identifier_Prefix (Mark);
      end Translate_Protected_Type_Subprograms;

      procedure Translate_Protected_Type_Body (Bod : Iir)
      is
         Decl : Iir_Protected_Type_Declaration;
         Mark : Id_Mark_Type;
         Info : Type_Info_Acc;
      begin
         Decl := Get_Protected_Type_Declaration (Bod);
         Info := Get_Info (Decl);

         Push_Identifier_Prefix (Mark, Get_Identifier (Bod));

         --  Create the object type
         Push_Instance_Factory (Info.Ortho_Type (Mode_Value));
         --  First, the previous instance.
         Chap2.Add_Subprg_Instance_Field
           (Info.T.Prot_Subprg_Instance_Field);
         --  Then the object lock
         Info.T.Prot_Lock_Field := Add_Instance_Factory_Field
           (Get_Identifier ("LOCK"), Ghdl_Ptr_Type);

         --  Translate declarations.
         Chap4.Translate_Declaration_Chain (Bod);

         Pop_Instance_Factory (Info.Ortho_Type (Mode_Value));

         Pop_Identifier_Prefix (Mark);
      end Translate_Protected_Type_Body;

      --  Call lock or unlock on a protected object.
      procedure Call_Ghdl_Protected_Procedure (Type_Def : Iir; Proc : O_Dnode)
      is
         Assoc : O_Assoc_List;
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Type_Def);
         Start_Association (Assoc, Proc);
         New_Association
           (Assoc,
            New_Unchecked_Address
              (New_Selected_Element
                 (Get_Instance_Ref (Info.Ortho_Type (Mode_Value)),
                  Info.T.Prot_Lock_Field),
               Ghdl_Ptr_Type));
         New_Procedure_Call (Assoc);
      end Call_Ghdl_Protected_Procedure;

      procedure Translate_Protected_Type_Body_Subprograms (Bod : Iir)
      is
         Decl : Iir;
         Info : Type_Info_Acc;
         Final : Boolean;
         Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
      begin
         Decl := Get_Protected_Type_Declaration (Bod);
         Info := Get_Info (Decl);

         --  Subprograms of BOD.
         Chap2.Push_Subprg_Instance (Info.Ortho_Type (Mode_Value),
                                     Info.Ortho_Ptr_Type (Mode_Value),
                                     Wki_Obj,
                                     Prev_Subprg_Instance);
         Chap2.Start_Prev_Subprg_Instance_Use_Via_Field
           (Prev_Subprg_Instance, Info.T.Prot_Subprg_Instance_Field);

         Chap4.Translate_Declaration_Chain_Subprograms (Bod, Null_Iir);

         Chap2.Finish_Prev_Subprg_Instance_Use_Via_Field
           (Prev_Subprg_Instance, Info.T.Prot_Subprg_Instance_Field);
         Chap2.Pop_Subprg_Instance (Wki_Obj, Prev_Subprg_Instance);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         --  Init subprogram
         declare
            Var_Obj : O_Dnode;
         begin
            Start_Subprogram_Body (Info.T.Prot_Init_Subprg);
            Chap2.Start_Subprg_Instance_Use (Info.T.Prot_Init_Instance);
            New_Var_Decl (Var_Obj, Wki_Obj, O_Storage_Local,
                          Info.Ortho_Ptr_Type (Mode_Value));

            --  Allocate the object
            New_Assign_Stmt
              (New_Obj (Var_Obj),
               Gen_Alloc (Alloc_System,
                          New_Lit (New_Sizeof (Info.Ortho_Type (Mode_Value),
                                               Ghdl_Index_Type)),
                          Info.Ortho_Ptr_Type (Mode_Value)));

            Chap2.Set_Subprg_Instance_Field
              (Var_Obj, Info.T.Prot_Subprg_Instance_Field,
               Info.T.Prot_Init_Instance);

            Push_Scope (Info.Ortho_Type (Mode_Value), Var_Obj);

            --   Create lock.
            Call_Ghdl_Protected_Procedure (Decl, Ghdl_Protected_Init);

            --   Elaborate fields.
            Open_Temp;
            Chap4.Elab_Declaration_Chain (Bod, Final);
            Close_Temp;

            Pop_Scope (Info.Ortho_Type (Mode_Value));

            New_Return_Stmt (New_Obj_Value (Var_Obj));
            Chap2.Finish_Subprg_Instance_Use (Info.T.Prot_Init_Instance);

            Finish_Subprogram_Body;
         end;

         --  Fini subprogram
         begin
            Start_Subprogram_Body (Info.T.Prot_Final_Subprg);
            Chap2.Start_Subprg_Instance_Use (Info.T.Prot_Final_Instance);

            --   Deallocate fields.
            if Final or True then
               Chap4.Final_Declaration_Chain (Bod, True);
            end if;

            --   Destroy lock.
            Call_Ghdl_Protected_Procedure (Decl, Ghdl_Protected_Fini);

            Chap2.Finish_Subprg_Instance_Use (Info.T.Prot_Final_Instance);
            Finish_Subprogram_Body;
         end;
      end Translate_Protected_Type_Body_Subprograms;

      ---------------
      --  Scalars  --
      ---------------

      --  Create a type_range structure.
      procedure Create_Scalar_Type_Range (Def : Iir; Target : O_Lnode)
      is
         T_Info : Type_Info_Acc;
         Base_Type : Iir;
         Expr : Iir;
         V : O_Dnode;
      begin
         Base_Type := Get_Base_Type (Def);
         T_Info := Get_Info (Base_Type);
         Expr := Get_Range_Constraint (Def);
         Open_Temp;
         V := Create_Temp_Ptr (T_Info.T.Range_Ptr_Type, Target);
         Chap7.Translate_Range_Ptr (V, Expr, Def);
         Close_Temp;
      end Create_Scalar_Type_Range;

      function Create_Static_Scalar_Type_Range (Def : Iir) return O_Cnode is
      begin
         return Chap7.Translate_Static_Range (Get_Range_Constraint (Def),
                                              Get_Base_Type (Def));
      end Create_Static_Scalar_Type_Range;

      procedure Create_Scalar_Type_Range_Type
        (Def : Iir; With_Length : Boolean)
      is
         Constr : O_Element_List;
         Info : Ortho_Info_Acc;
      begin
         Info := Get_Info (Def);
         Start_Record_Type (Constr);
         New_Record_Field
           (Constr, Info.T.Range_Left, Wki_Left,
            Info.Ortho_Type (Mode_Value));
         New_Record_Field
           (Constr, Info.T.Range_Right, Wki_Right,
            Info.Ortho_Type (Mode_Value));
         New_Record_Field
           (Constr, Info.T.Range_Dir, Wki_Dir, Ghdl_Dir_Type_Node);
         if With_Length then
            New_Record_Field
              (Constr, Info.T.Range_Length, Wki_Length, Ghdl_Index_Type);
         else
            Info.T.Range_Length := O_Fnode_Null;
         end if;
         Finish_Record_Type (Constr, Info.T.Range_Type);
         New_Type_Decl (Create_Identifier ("TRT"), Info.T.Range_Type);
         Info.T.Range_Ptr_Type := New_Access_Type (Info.T.Range_Type);
         New_Type_Decl (Create_Identifier ("TRPTR"),
                        Info.T.Range_Ptr_Type);
      end Create_Scalar_Type_Range_Type;

      function Create_Static_Type_Definition_Type_Range (Def : Iir)
        return O_Cnode
      is
      begin
         case Get_Kind (Def) is
            when Iir_Kind_Enumeration_Type_Definition
              | Iir_Kind_Enumeration_Subtype_Definition
              | Iir_Kind_Integer_Subtype_Definition
              | Iir_Kind_Floating_Subtype_Definition
              | Iir_Kind_Physical_Subtype_Definition =>
               return Create_Static_Scalar_Type_Range (Def);

            when Iir_Kind_Array_Subtype_Definition =>
               return Create_Static_Array_Subtype_Bounds (Def);

            when Iir_Kind_Array_Type_Definition =>
               return O_Cnode_Null;

            when others =>
               Error_Kind ("create_static_type_definition_type_range", Def);
         end case;
      end Create_Static_Type_Definition_Type_Range;

      procedure Create_Type_Definition_Type_Range (Def : Iir)
      is
         Target : O_Lnode;
         Info : Type_Info_Acc;
      begin
         case Get_Kind (Def) is
            when Iir_Kind_Enumeration_Type_Definition
              | Iir_Kind_Enumeration_Subtype_Definition
              | Iir_Kind_Integer_Subtype_Definition
              | Iir_Kind_Floating_Subtype_Definition
              | Iir_Kind_Physical_Subtype_Definition =>
               Target := Get_Var (Get_Info (Def).T.Range_Var);
               Create_Scalar_Type_Range (Def, Target);

            when Iir_Kind_Array_Subtype_Definition =>
               if Get_Constraint_State (Def) = Fully_Constrained then
                  Info := Get_Info (Def);
                  if not Info.T.Static_Bounds then
                     Target := Get_Var (Info.T.Array_Bounds);
                     Create_Array_Subtype_Bounds (Def, Target);
                  end if;
               end if;

            when Iir_Kind_Array_Type_Definition =>
               declare
                  Index_List : constant Iir_List :=
                    Get_Index_Subtype_List (Def);
                  Index : Iir;
               begin
                  for I in Natural loop
                     Index := Get_Index_Type (Index_List, I);
                     exit when Index = Null_Iir;
                     if Is_Anonymous_Type_Definition (Index) then
                        Create_Type_Definition_Type_Range (Index);
                     end if;
                  end loop;
               end;
               Translate_Dynamic_Unidimensional_Array_Length_One (Def);
               return;
            when Iir_Kind_Access_Type_Definition
              | Iir_Kind_Access_Subtype_Definition
              | Iir_Kind_File_Type_Definition
              | Iir_Kind_Record_Type_Definition
              | Iir_Kind_Record_Subtype_Definition
              | Iir_Kind_Protected_Type_Declaration =>
               return;

            when others =>
               Error_Kind ("create_type_definition_type_range", Def);
         end case;
      end Create_Type_Definition_Type_Range;

      procedure Create_Record_Size_Var (Def : Iir; Kind : Object_Kind_Type)
      is
         Info : constant Type_Info_Acc := Get_Info (Def);
         List : constant Iir_List :=
           Get_Elements_Declaration_List (Get_Base_Type (Def));
         El : Iir_Element_Declaration;
         El_Type : Iir;
         El_Tinfo : Type_Info_Acc;
         Inner_Type : Iir;
         Inner_Tinfo : Type_Info_Acc;
         Res : O_Enode;
         Align_Var : O_Dnode;
         If_Blk : O_If_Block;
      begin
         Open_Temp;

         --  Start with the size of the 'base' record, that
         --  contains all non-complex types and an offset for
         --  each complex types.
         Res := New_Lit (New_Sizeof (Info.Ortho_Type (Kind), Ghdl_Index_Type));

         --  Start with alignment of the record.
         --  ALIGN = ALIGNOF (record)
         if Kind = Mode_Value then
            Align_Var := Create_Temp (Ghdl_Index_Type);
            New_Assign_Stmt
              (New_Obj (Align_Var),
               Get_Type_Alignmask (Info.Ortho_Type (Kind)));
         end if;

         for I in Natural loop
            El := Get_Nth_Element (List, I);
            exit when El = Null_Iir;
            El_Type := Get_Type (El);
            El_Tinfo := Get_Info (El_Type);
            if Is_Complex_Type (El_Tinfo) then
               Inner_Type := Get_Innermost_Non_Array_Element (El_Type);

               --  Align (only for Mode_Value) the size,
               --  and add the size of the element.
               if Kind = Mode_Value then
                  Inner_Tinfo := Get_Info (Inner_Type);
                  --  If alignmask (Inner_Type) > alignmask then
                  --    alignmask = alignmask (Inner_type);
                  --  end if;
                  Start_If_Stmt
                    (If_Blk,
                     New_Compare_Op (ON_Gt,
                                     Get_Type_Alignmask (Inner_Tinfo),
                                     New_Obj_Value (Align_Var),
                                     Ghdl_Bool_Type));
                  New_Assign_Stmt
                    (New_Obj (Align_Var), Get_Type_Alignmask (Inner_Tinfo));
                  Finish_If_Stmt (If_Blk);
                  Res := Realign (Res, Inner_Type);
               end if;
               Res := New_Dyadic_Op
                 (ON_Add_Ov,
                  New_Value (Get_Var (El_Tinfo.C (Kind).Size_Var)),
                  Res);
            end if;
         end loop;
         if Kind = Mode_Value then
            Res := Realign (Res, Align_Var);
         end if;
         New_Assign_Stmt (Get_Var (Info.C (Kind).Size_Var), Res);
         Close_Temp;
      end Create_Record_Size_Var;

      procedure Create_Array_Size_Var (Def : Iir; Kind : Object_Kind_Type)
      is
         Info : constant Type_Info_Acc := Get_Info (Def);
         El_Type : constant Iir := Get_Element_Subtype (Def);
         Res : O_Enode;
      begin
         Res := New_Dyadic_Op
           (ON_Mul_Ov,
            Get_Array_Type_Length (Def),
            Chap3.Get_Object_Size (T2M (El_Type, Kind), El_Type));
         New_Assign_Stmt (Get_Var (Info.C (Kind).Size_Var), Res);
      end Create_Array_Size_Var;

      procedure Create_Type_Definition_Size_Var (Def : Iir)
      is
         Info : constant Type_Info_Acc := Get_Info (Def);
      begin
         if not Is_Complex_Type (Info) then
            return;
         end if;

         for Kind in Mode_Value .. Type_To_Last_Object_Kind (Def) loop
            if Info.C (Kind).Size_Var /= null then
               case Info.Type_Mode is
                  when Type_Mode_Non_Composite
                    | Type_Mode_Fat_Array
                    | Type_Mode_Unknown
                    | Type_Mode_Protected =>
                     raise Internal_Error;
                  when Type_Mode_Record =>
                     Create_Record_Size_Var (Def, Kind);
                  when Type_Mode_Array =>
                     Create_Array_Size_Var (Def, Kind);
               end case;
            end if;
         end loop;
      end Create_Type_Definition_Size_Var;

      procedure Create_Type_Range_Var (Def : Iir)
      is
         Info : Type_Info_Acc;
         Base_Info : Type_Info_Acc;
         Val : O_Cnode;
         Suffix : String (1 .. 3) := "xTR";
      begin
         Info := Get_Info (Def);
         case Get_Kind (Def) is
            when Iir_Kinds_Subtype_Definition =>
               Suffix (1) := 'S'; -- "STR";
            when Iir_Kind_Enumeration_Type_Definition =>
               Suffix (1) := 'B'; -- "BTR";
            when others =>
               raise Internal_Error;
         end case;
         Base_Info := Get_Info (Get_Base_Type (Def));
         case Get_Type_Staticness (Def) is
            when None
              | Globally =>
               Info.T.Range_Var := Create_Var
                 (Create_Var_Identifier (Suffix), Base_Info.T.Range_Type);
            when Locally =>
               if Global_Storage = O_Storage_External then
                  --  Do not create the value of the type desc, since it
                  --  is never dereferenced in a static type desc.
                  Val := O_Cnode_Null;
               else
                  Val := Create_Static_Type_Definition_Type_Range (Def);
               end if;
               Info.T.Range_Var := Create_Global_Const
                 (Create_Identifier (Suffix),
                  Base_Info.T.Range_Type, Global_Storage, Val);
            when Unknown =>
               raise Internal_Error;
         end case;
      end Create_Type_Range_Var;


      --  Call HANDLE_A_SUBTYPE for all type/subtypes declared with DEF
      --  (of course, this is a noop if DEF is not a composite type).
      generic
         with procedure Handle_A_Subtype (Atype : Iir);
      procedure Handle_Anonymous_Subtypes (Def : Iir);

      procedure Handle_Anonymous_Subtypes (Def : Iir) is
      begin
         case Get_Kind (Def) is
            when Iir_Kind_Array_Type_Definition
              | Iir_Kind_Array_Subtype_Definition =>
               declare
                  Asub : Iir;
               begin
                  Asub := Get_Element_Subtype (Def);
                  if Is_Anonymous_Type_Definition (Asub) then
                     Handle_A_Subtype (Asub);
                  end if;
               end;
            when Iir_Kind_Record_Type_Definition =>
               declare
                  El : Iir;
                  Asub : Iir;
                  List : Iir_List;
               begin
                  List := Get_Elements_Declaration_List (Def);
                  for I in Natural loop
                     El := Get_Nth_Element (List, I);
                     exit when El = Null_Iir;
                     Asub := Get_Type (El);
                     if Is_Anonymous_Type_Definition (Asub) then
                        Handle_A_Subtype (Asub);
                     end if;
                  end loop;
               end;
            when others =>
               null;
         end case;
      end Handle_Anonymous_Subtypes;

      --  Return TRUE iff LIT is equal to the high (IS_HI=TRUE) or low
      --  (IS_HI=false) limit of the base type of DEF.  MODE is the mode of
      --  DEF.
      function Is_Equal_Limit (Lit : Iir;
                               Is_Hi : Boolean;
                               Def : Iir;
                               Mode : Type_Mode_Type) return Boolean
      is
      begin
         case Mode is
            when Type_Mode_B2 =>
               declare
                  V : Iir_Int32;
               begin
                  V := Iir_Int32 (Eval_Pos (Lit));
                  if Is_Hi then
                     return V = 1;
                  else
                     return V = 0;
                  end if;
               end;
            when Type_Mode_E8 =>
               declare
                  V : Iir_Int32;
                  Base_Type : Iir;
               begin
                  V := Iir_Int32 (Eval_Pos (Lit));
                  if Is_Hi then
                     Base_Type := Get_Base_Type (Def);
                     return V = Iir_Int32
                       (Get_Nbr_Elements
                        (Get_Enumeration_Literal_List (Base_Type))) - 1;
                  else
                     return V = 0;
                  end if;
               end;
            when Type_Mode_I32 =>
               declare
                  V : Iir_Int32;
               begin
                  V := Iir_Int32 (Get_Value (Lit));
                  if Is_Hi then
                     return V = Iir_Int32'Last;
                  else
                     return V = Iir_Int32'First;
                  end if;
               end;
            when Type_Mode_P32 =>
               declare
                  V : Iir_Int32;
               begin
                  V := Iir_Int32 (Get_Physical_Value (Lit));
                  if Is_Hi then
                     return V = Iir_Int32'Last;
                  else
                     return V = Iir_Int32'First;
                  end if;
               end;
            when Type_Mode_I64 =>
               declare
                  V : Iir_Int64;
               begin
                  V := Get_Value (Lit);
                  if Is_Hi then
                     return V = Iir_Int64'Last;
                  else
                     return V = Iir_Int64'First;
                  end if;
               end;
            when Type_Mode_P64 =>
               declare
                  V : Iir_Int64;
               begin
                  V := Get_Physical_Value (Lit);
                  if Is_Hi then
                     return V = Iir_Int64'Last;
                  else
                     return V = Iir_Int64'First;
                  end if;
               end;
            when Type_Mode_F64 =>
               declare
                  V : Iir_Fp64;
               begin
                  V := Get_Fp_Value (Lit);
                  if Is_Hi then
                     return V = Iir_Fp64'Last;
                  else
                     return V = Iir_Fp64'First;
                  end if;
               end;
            when others =>
               Error_Kind ("is_equal_limit " & Type_Mode_Type'Image (Mode),
                           Lit);
         end case;
      end Is_Equal_Limit;

      procedure Create_Subtype_Info_From_Type (Def : Iir;
                                               Subtype_Info : Type_Info_Acc;
                                               Base_Info : Type_Info_Acc)
      is
         Rng : Iir;
         Lo, Hi : Iir;
      begin
         Subtype_Info.Ortho_Type := Base_Info.Ortho_Type;
         Subtype_Info.Ortho_Ptr_Type := Base_Info.Ortho_Ptr_Type;
         Subtype_Info.Type_Mode := Base_Info.Type_Mode;
         Subtype_Info.T := Base_Info.T;

         Rng := Get_Range_Constraint (Def);
         if Get_Expr_Staticness (Rng) /= Locally then
            --  Bounds are not known.
            --  Do the checks.
            Subtype_Info.T.Nocheck_Hi := False;
            Subtype_Info.T.Nocheck_Low := False;
         else
            --  Bounds are locally static.
            Get_Low_High_Limit (Rng, Lo, Hi);
            Subtype_Info.T.Nocheck_Hi :=
              Is_Equal_Limit (Hi, True, Def, Base_Info.Type_Mode);
            Subtype_Info.T.Nocheck_Low :=
              Is_Equal_Limit (Lo, False, Def, Base_Info.Type_Mode);
         end if;
      end Create_Subtype_Info_From_Type;

      --  Note: boolean types are translated by translate_bool_type_definition!
      procedure Translate_Type_Definition
        (Def : Iir; With_Vars : Boolean := True)
      is
         Info : Ortho_Info_Acc;
         Base_Info : Type_Info_Acc;
         Base_Type : Iir;
         Complete_Info : Incomplete_Type_Info_Acc;
      begin
         --  Handle the special case of incomplete type.
         if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
            Translate_Incomplete_Type (Def);
            return;
         end if;

         --  If the definition is already translated, return now.
         Info := Get_Info (Def);
         if Info /= null then
            if Info.Kind = Kind_Type then
               return;
            end if;
            if Info.Kind = Kind_Incomplete_Type then
               Complete_Info := Info;
               Clear_Info (Def);
               if Complete_Info.Incomplete_Array /= null then
                  Info := Complete_Info.Incomplete_Array;
                  Set_Info (Def, Info);
                  Unchecked_Deallocation (Complete_Info);
               else
                  Info := Add_Info (Def, Kind_Type);
               end if;
            else
               raise Internal_Error;
            end if;
         else
            Complete_Info := null;
            Info := Add_Info (Def, Kind_Type);
         end if;

         Base_Type := Get_Base_Type (Def);
         Base_Info := Get_Info (Base_Type);

         case Get_Kind (Def) is
            when Iir_Kind_Enumeration_Type_Definition =>
               Translate_Enumeration_Type (Def);
               Create_Scalar_Type_Range_Type (Def, True);
               Create_Type_Range_Var (Def);
               --Create_Type_Desc_Var (Def);

            when Iir_Kind_Integer_Type_Definition =>
               Translate_Integer_Type (Def);
               Create_Scalar_Type_Range_Type (Def, True);

            when Iir_Kind_Physical_Type_Definition =>
               Translate_Physical_Type (Def);
               Create_Scalar_Type_Range_Type (Def, False);
               if With_Vars and Get_Type_Staticness (Def) /= Locally then
                  Translate_Physical_Units (Def);
               else
                  Info.T.Range_Var := null;
               end if;

            when Iir_Kind_Floating_Type_Definition =>
               Translate_Floating_Type (Def);
               Create_Scalar_Type_Range_Type (Def, False);

            when Iir_Kind_Enumeration_Subtype_Definition
              | Iir_Kind_Physical_Subtype_Definition
              | Iir_Kind_Integer_Subtype_Definition
              | Iir_Kind_Floating_Subtype_Definition =>
               Create_Subtype_Info_From_Type (Def, Info, Base_Info);
               if With_Vars then
                  Create_Type_Range_Var (Def);
               else
                  Info.T.Range_Var := null;
               end if;

            when Iir_Kind_Array_Type_Definition =>
               declare
                  El_Type : Iir;
                  Mark : Id_Mark_Type;
               begin
                  El_Type := Get_Element_Subtype (Def);
                  if Get_Info (El_Type) = null then
                     Push_Identifier_Prefix (Mark, "ET");
                     Translate_Type_Definition (El_Type);
                     Pop_Identifier_Prefix (Mark);
                  end if;
               end;
               Translate_Array_Type (Def);
            -- Info.Type_Range_Type := Create_Array_Type_Bounds_Type (Def, Id);

            when Iir_Kind_Array_Subtype_Definition =>
               if Get_Index_Constraint_Flag (Def) then
                  if Base_Info = null or else Base_Info.Type_Incomplete then
                     declare
                        Mark : Id_Mark_Type;
                     begin
                        Push_Identifier_Prefix (Mark, "BT");
                        Translate_Type_Definition (Base_Type);
                        Pop_Identifier_Prefix (Mark);
                        Base_Info := Get_Info (Base_Type);
                     end;
                  end if;
                  Translate_Array_Subtype (Def);
                  Info.T := Base_Info.T;
                  --Info.Type_Range_Type := Base_Info.Type_Range_Type;
                  if With_Vars then
                     Create_Array_Subtype_Bounds_Var (Def, False);
                  end if;
               else
                  Free_Info (Def);
                  Set_Info (Def, Base_Info);
               end if;

            when Iir_Kind_Record_Type_Definition =>
               Translate_Record_Type (Def);
               Info.T := Ortho_Info_Type_Record_Init;

            when Iir_Kind_Record_Subtype_Definition
              | Iir_Kind_Access_Subtype_Definition =>
               Free_Info (Def);
               Set_Info (Def, Base_Info);

            when Iir_Kind_Access_Type_Definition =>
               declare
                  Dtype : constant Iir := Get_Designated_Type (Def);
               begin
                  --  Translate the subtype
                  if Is_Anonymous_Type_Definition (Dtype) then
                     Translate_Type_Definition (Dtype);
                  end if;
                  Translate_Access_Type (Def);
               end;

            when Iir_Kind_File_Type_Definition =>
               Translate_File_Type (Def);
               Info.T := Ortho_Info_Type_File_Init;
               if With_Vars then
                  Create_File_Type_Var (Def);
               end if;

            when Iir_Kind_Protected_Type_Declaration =>
               Translate_Protected_Type (Def);
               Info.T := Ortho_Info_Type_Prot_Init;

            when others =>
               Error_Kind ("translate_type_definition", Def);
         end case;

         if Complete_Info /= null then
            Translate_Complete_Type (Complete_Info, Def);
         end if;
      end Translate_Type_Definition;

      procedure Translate_Bool_Type_Definition (Def : Iir)
      is
         Info : Type_Info_Acc;
      begin
         --  If the definition is already translated, return now.
         Info := Get_Info (Def);
         if Info /= null then
            raise Internal_Error;
         end if;

         Info := Add_Info (Def, Kind_Type);

         if Get_Kind (Def) /= Iir_Kind_Enumeration_Type_Definition then
            raise Internal_Error;
         end if;
         Translate_Bool_Type (Def);

         --  This is usually done in translate_type_definition, but boolean
         --  types are not handled by translate_type_definition.
         Create_Scalar_Type_Range_Type (Def, True);
      end Translate_Bool_Type_Definition;

      procedure Translate_Type_Subprograms (Decl : Iir)
      is
         Def : Iir;
         Tinfo : Type_Info_Acc;
         Id : Name_Id;
      begin
         Def := Get_Type_Definition (Decl);

         if Get_Kind (Def) in Iir_Kinds_Subtype_Definition then
            --  Also elaborate the base type, iff DEF and its BASE_TYPE have
            --  been declared by the same type declarator.  This avoids several
            --  elaboration of the same type.
            Def := Get_Base_Type (Def);
            if Get_Type_Declarator (Def) /= Decl then
               --  Can this happen ??
               raise Internal_Error;
            end if;
         elsif Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
            return;
         end if;

         if Get_Kind (Def) = Iir_Kind_Protected_Type_Declaration then
            Translate_Protected_Type_Subprograms (Def);
         end if;

         Tinfo := Get_Info (Def);
         if not Is_Complex_Type (Tinfo)
           or else Tinfo.C (Mode_Value).Builder_Need_Func = False
         then
            return;
         end if;

         --  Declare subprograms.
         Id := Get_Identifier (Decl);
         Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Value);
         if Get_Has_Signal_Flag (Def) then
            Create_Builder_Subprogram_Decl (Tinfo, Id, Mode_Signal);
         end if;

         if Global_Storage = O_Storage_External then
            return;
         end if;

         --  Define subprograms.
         case Get_Kind (Def) is
            when Iir_Kind_Array_Type_Definition =>
               Create_Array_Type_Builder (Def, Mode_Value);
               if Get_Has_Signal_Flag (Def) then
                  Create_Array_Type_Builder (Def, Mode_Signal);
               end if;
            when Iir_Kind_Record_Type_Definition =>
               Create_Record_Type_Builder (Def, Mode_Value);
               if Get_Has_Signal_Flag (Def) then
                  Create_Record_Type_Builder (Def, Mode_Signal);
               end if;
            when others =>
               Error_Kind ("translate_type_subprograms", Def);
         end case;
      end Translate_Type_Subprograms;

      --  Initialize the objects related to a type (type range and type
      --  descriptor).
      procedure Elab_Type_Definition (Def : Iir);
      procedure Elab_Type_Definition_Depend is new Handle_Anonymous_Subtypes
        (Handle_A_Subtype => Elab_Type_Definition);
      procedure Elab_Type_Definition (Def : Iir) is
      begin
         case Get_Kind (Def) is
            when Iir_Kind_Incomplete_Type_Definition =>
               --  Nothing to do.
               return;
            when Iir_Kind_Protected_Type_Declaration =>
               --  Elaboration subprograms interfaces.
               declare
                  Final : Boolean;
               begin
                  Chap4.Elab_Declaration_Chain (Def, Final);
                  if Final then
                     raise Internal_Error;
                  end if;
               end;
               return;
            when others =>
               null;
         end case;

         if Get_Type_Staticness (Def) = Locally then
            return;
         end if;

         Elab_Type_Definition_Depend (Def);

         Create_Type_Definition_Type_Range (Def);
         Create_Type_Definition_Size_Var (Def);
      end Elab_Type_Definition;

      procedure Translate_Named_Type_Definition (Def : Iir; Id : Name_Id)
      is
         Mark : Id_Mark_Type;
      begin
         Push_Identifier_Prefix (Mark, Id);
         Chap3.Translate_Type_Definition (Def);
         Pop_Identifier_Prefix (Mark);
      end Translate_Named_Type_Definition;

      procedure Translate_Anonymous_Type_Definition
        (Def : Iir; Transient : Boolean)
      is
         Mark : Id_Mark_Type;
         Type_Info : Type_Info_Acc;
      begin
         Type_Info := Get_Info (Def);
         if Type_Info /= null then
            return;
         end if;
         Push_Identifier_Prefix_Uniq (Mark);
         Chap3.Translate_Type_Definition (Def, False);
         if Transient then
            Add_Transient_Type_In_Temp (Def);
         end if;
         Pop_Identifier_Prefix (Mark);
      end Translate_Anonymous_Type_Definition;

      procedure Destroy_Type_Info (Atype : Iir)
      is
         Type_Info : Type_Info_Acc;
      begin
         Type_Info := Get_Info (Atype);
         Free_Type_Info (Type_Info, False);
         Clear_Info (Atype);
      end Destroy_Type_Info;

      procedure Translate_Object_Subtype (Decl : Iir;
                                          With_Vars : Boolean := True)
      is
         Mark : Id_Mark_Type;
         Mark2 : Id_Mark_Type;
         Def : Iir;
      begin
         Def := Get_Type (Decl);
         if Is_Anonymous_Type_Definition (Def) then
            Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
            Push_Identifier_Prefix (Mark2, "OT");
            Chap3.Translate_Type_Definition (Def, With_Vars);
            Pop_Identifier_Prefix (Mark2);
            Pop_Identifier_Prefix (Mark);
         end if;
      end Translate_Object_Subtype;

      procedure Elab_Object_Subtype (Def : Iir) is
      begin
         if Is_Anonymous_Type_Definition (Def) then
            Elab_Type_Definition (Def);
         end if;
      end Elab_Object_Subtype;

      procedure Elab_Type_Declaration (Decl : Iir)
      is
      begin
         Elab_Type_Definition (Get_Type_Definition (Decl));
      end Elab_Type_Declaration;

      procedure Elab_Subtype_Declaration (Decl : Iir_Subtype_Declaration)
      is
      begin
         Elab_Type_Definition (Get_Type (Decl));
      end Elab_Subtype_Declaration;

      function Get_Thin_Array_Length (Atype : Iir) return O_Cnode
      is
         Indexes_List : constant Iir_List := Get_Index_Subtype_List (Atype);
         Nbr_Dim : constant Natural := Get_Nbr_Elements (Indexes_List);
         Index : Iir;
         Val : Iir_Int64;
         Rng : Iir;
      begin
         Val := 1;
         for I in 0 .. Nbr_Dim - 1 loop
            Index := Get_Index_Type (Indexes_List, I);
            Rng := Get_Range_Constraint (Index);
            Val := Val * Eval_Discrete_Range_Length (Rng);
         end loop;
         return New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Val));
      end Get_Thin_Array_Length;

      function Bounds_To_Range (B : Mnode; Atype : Iir; Dim : Positive)
        return Mnode
      is
         Tinfo : constant Type_Info_Acc := Get_Type_Info (B);
         Index_Type : constant Iir :=
           Get_Index_Type (Get_Base_Type (Atype), Dim - 1);
         Iinfo : constant Type_Info_Acc :=
           Get_Info (Get_Base_Type (Index_Type));
      begin
         return Lv2M (New_Selected_Element (M2Lv (B),
                                            Tinfo.T.Bounds_Vector (Dim)),
                      Iinfo,
                      Get_Object_Kind (B),
                      Iinfo.T.Range_Type,
                      Iinfo.T.Range_Ptr_Type);
      end Bounds_To_Range;

      function Type_To_Range (Atype : Iir) return Mnode
      is
         Info : constant Type_Info_Acc := Get_Info (Atype);
      begin
         return Varv2M (Info.T.Range_Var, Info, Mode_Value,
                        Info.T.Range_Type, Info.T.Range_Ptr_Type);
      end Type_To_Range;

      function Range_To_Length (R : Mnode) return Mnode
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Type_Info (R);
         return Lv2M (New_Selected_Element (M2Lv (R),
                                            Tinfo.T.Range_Length),
                      Tinfo,
                      Mode_Value);
      end Range_To_Length;

      function Range_To_Dir (R : Mnode) return Mnode
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Type_Info (R);
         return Lv2M (New_Selected_Element (M2Lv (R),
                                            Tinfo.T.Range_Dir),
                      Tinfo,
                      Mode_Value);
      end Range_To_Dir;

      function Range_To_Left (R : Mnode) return Mnode
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Type_Info (R);
         return Lv2M (New_Selected_Element (M2Lv (R),
                                            Tinfo.T.Range_Left),
                      Tinfo,
                      Mode_Value);
      end Range_To_Left;

      function Range_To_Right (R : Mnode) return Mnode
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Type_Info (R);
         return Lv2M (New_Selected_Element (M2Lv (R),
                                            Tinfo.T.Range_Right),
                      Tinfo,
                      Mode_Value);
      end Range_To_Right;

      function Get_Array_Type_Bounds (Info : Type_Info_Acc) return Mnode
      is
      begin
         case Info.Type_Mode is
            when Type_Mode_Fat_Array =>
               raise Internal_Error;
            when Type_Mode_Array =>
               return Varv2M (Info.T.Array_Bounds,
                              Info, Mode_Value,
                              Info.T.Bounds_Type,
                              Info.T.Bounds_Ptr_Type);
            when others =>
               raise Internal_Error;
         end case;
      end Get_Array_Type_Bounds;

      function Get_Array_Type_Bounds (Atype : Iir) return Mnode is
      begin
         return Get_Array_Type_Bounds (Get_Info (Atype));
      end Get_Array_Type_Bounds;

      function Get_Array_Bounds (Arr : Mnode) return Mnode
      is
         Info : constant Type_Info_Acc := Get_Type_Info (Arr);
      begin
         case Info.Type_Mode is
            when Type_Mode_Fat_Array
              | Type_Mode_Fat_Acc =>
               declare
                  Kind : Object_Kind_Type;
               begin
                  Kind := Get_Object_Kind (Arr);
                  return Lp2M
                    (New_Selected_Element (M2Lv (Arr),
                                           Info.T.Bounds_Field (Kind)),
                     Info,
                     Mode_Value,
                     Info.T.Bounds_Type,
                     Info.T.Bounds_Ptr_Type);
               end;
            when Type_Mode_Array =>
               return Get_Array_Type_Bounds (Info);
            when others =>
               raise Internal_Error;
         end case;
      end Get_Array_Bounds;

      function Get_Array_Range (Arr : Mnode; Atype : Iir; Dim : Positive)
                               return Mnode is
      begin
         return Bounds_To_Range (Get_Array_Bounds (Arr), Atype, Dim);
      end Get_Array_Range;

      function Get_Array_Type_Length (Atype : Iir) return O_Enode
      is
         Index_List : Iir_List;
         Nbr_Dim : Natural;
         Dim_Length : O_Enode;
         Res : O_Enode;
         Type_Info : Type_Info_Acc;
         Bounds : Mnode;
      begin
         --  Handle non-complex array case.
         Type_Info := Get_Info (Atype);
         if Type_Info.Type_Locally_Constrained then
            return New_Lit (Get_Thin_Array_Length (Atype));
         end if;

         --  FIXME: share code with get_array_length ???
         Index_List := Get_Index_Subtype_List (Atype);
         Nbr_Dim := Get_Nbr_Elements (Index_List);
         Bounds := Get_Array_Type_Bounds (Atype);
         if Nbr_Dim > 1 then
            Bounds := Stabilize (Bounds);
         end if;
         for Dim in 1 .. Nbr_Dim loop
            Dim_Length :=
              M2E (Range_To_Length (Bounds_To_Range (Bounds, Atype, Dim)));
            if Dim = 1 then
               Res := Dim_Length;
            else
               Res := New_Dyadic_Op (ON_Mul_Ov, Res, Dim_Length);
            end if;
         end loop;
         return Res;
      end Get_Array_Type_Length;

      function Get_Bounds_Ptr_Length (Ptr : O_Dnode; Atype : Iir)
                                     return O_Enode
      is
         Index_List : constant Iir_List := Get_Index_Subtype_List (Atype);
         Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List);
         Index_Type : Iir;
         Dim_Length : O_Enode;
         Res : O_Enode;
         Type_Info : constant Type_Info_Acc :=
           Get_Info (Get_Base_Type (Atype));
         Index_Info : Type_Info_Acc;
      begin
         for Dim in 1 .. Nbr_Dim loop
            Index_Type := Get_Index_Type (Index_List, Dim - 1);
            Index_Info := Get_Info (Get_Base_Type (Index_Type));
            Dim_Length := New_Value
              (New_Selected_Element
                 (New_Selected_Element (New_Acc_Value (New_Obj (Ptr)),
                                        Type_Info.T.Bounds_Vector (Dim)),
                  Index_Info.T.Range_Length));
            if Dim = 1 then
               Res := Dim_Length;
            else
               Res := New_Dyadic_Op (ON_Mul_Ov, Res, Dim_Length);
            end if;
         end loop;
         return Res;
      end Get_Bounds_Ptr_Length;

      function Get_Array_Length (Arr : Mnode; Atype : Iir) return O_Enode
      is
         Index_List : Iir_List;
         Nbr_Dim : Natural;
         Dim_Length : O_Enode;
         Res : O_Enode;
         Type_Info : Type_Info_Acc;
         B : Mnode;
      begin
         --  Handle thin array case.
         Type_Info := Get_Info (Atype);
         if Type_Info.Type_Locally_Constrained then
            return New_Lit (Get_Thin_Array_Length (Atype));
         end if;

         Index_List := Get_Index_Subtype_List (Atype);
         Nbr_Dim := Get_Nbr_Elements (Index_List);
         for Dim in 1 .. Nbr_Dim loop
            B := Get_Array_Bounds (Arr);
            Dim_Length :=
              M2E (Range_To_Length (Bounds_To_Range (B, Atype, Dim)));
            if Dim = 1 then
               Res := Dim_Length;
            else
               Res := New_Dyadic_Op (ON_Mul_Ov, Res, Dim_Length);
            end if;
         end loop;
         return Res;
      end Get_Array_Length;

      function Get_Array_Base (Arr : Mnode) return Mnode
      is
         Info : Type_Info_Acc;
      begin
         Info := Get_Type_Info (Arr);
         case Info.Type_Mode is
            when Type_Mode_Fat_Array
              | Type_Mode_Fat_Acc =>
               declare
                  Kind : Object_Kind_Type;
               begin
                  Kind := Get_Object_Kind (Arr);
                  return Lp2M
                    (New_Selected_Element (M2Lv (Arr),
                                           Info.T.Base_Field (Kind)),
                     Info,
                     Get_Object_Kind (Arr),
                     Info.T.Base_Type (Kind),
                     Info.T.Base_Ptr_Type (Kind));
               end;
            when Type_Mode_Array =>
               return Arr;
            when others =>
               raise Internal_Error;
         end case;
      end Get_Array_Base;

      function Reindex_Complex_Array
        (Base : Mnode; Atype : Iir; Index : O_Enode; Res_Info : Type_Info_Acc)
        return Mnode
      is
         El_Type : constant Iir := Get_Element_Subtype (Atype);
         El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
         Kind : constant Object_Kind_Type := Get_Object_Kind (Base);
      begin
         pragma Assert (Is_Complex_Type (El_Tinfo));
         return
           E2M
           (New_Unchecked_Address
              (New_Slice
                 (New_Access_Element
                    (New_Convert_Ov (M2E (Base), Char_Ptr_Type)),
                  Chararray_Type,
                  New_Dyadic_Op (ON_Mul_Ov,
                                 New_Value
                                   (Get_Var (El_Tinfo.C (Kind).Size_Var)),
                                 Index)),
               El_Tinfo.Ortho_Ptr_Type (Kind)),
            Res_Info, Kind);
      end Reindex_Complex_Array;

      function Index_Base (Base : Mnode; Atype : Iir; Index : O_Enode)
        return Mnode
      is
         El_Type : constant Iir := Get_Element_Subtype (Atype);
         El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
         Kind : constant Object_Kind_Type := Get_Object_Kind (Base);
      begin
         if Is_Complex_Type (El_Tinfo) then
            return Reindex_Complex_Array (Base, Atype, Index, El_Tinfo);
         else
            return Lv2M (New_Indexed_Element (M2Lv (Base), Index),
                         El_Tinfo, Kind);
         end if;
      end Index_Base;

      function Slice_Base (Base : Mnode; Atype : Iir; Index : O_Enode)
        return Mnode
      is
         T_Info : constant Type_Info_Acc :=  Get_Info (Atype);
         El_Type : constant Iir := Get_Element_Subtype (Atype);
         El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
         Kind : constant Object_Kind_Type := Get_Object_Kind (Base);
      begin
         if Is_Complex_Type (El_Tinfo) then
            return Reindex_Complex_Array (Base, Atype, Index, T_Info);
         else
            return Lv2M (New_Slice (M2Lv (Base),
                                    T_Info.T.Base_Type (Kind),
                                    Index),
                         False,
                         T_Info.T.Base_Type (Kind),
                         T_Info.T.Base_Ptr_Type (Kind),
                         T_Info, Kind);
         end if;
      end Slice_Base;

      function Get_Array_Ptr_Base_Ptr
        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
        return O_Lnode
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Info (Atype);
         case Tinfo.Type_Mode is
            when Type_Mode_Fat_Array =>
               return New_Selected_Element
                 (New_Access_Element (New_Value (Ptr)),
                  Tinfo.T.Base_Field (Is_Sig));
            when Type_Mode_Array =>
               return Ptr;
            when others =>
               raise Internal_Error;
         end case;
      end Get_Array_Ptr_Base_Ptr;

      function Get_Array_Ptr_Range_Ptr (Ptr : O_Lnode;
                                        Array_Type : Iir;
                                        Dim : Natural;
                                        Is_Sig : Object_Kind_Type)
        return O_Enode
      is
         Array_Info : constant Type_Info_Acc := Get_Info (Array_Type);
         Index_Type : constant Iir := Get_Index_Type (Array_Type, Dim - 1);
         Index_Info : constant Type_Info_Acc :=
           Get_Info (Get_Base_Type (Index_Type));
         Res : O_Lnode;
      begin
         case Array_Info.Type_Mode is
            when Type_Mode_Array =>
               --  Extract bound variable.
               Res := Get_Var (Array_Info.T.Array_Bounds);
            when Type_Mode_Fat_Array =>
               --  From fat record, extract bounds field.
               Res := New_Acc_Value
                 (New_Selected_Acc_Value
                  (Ptr, Array_Info.T.Bounds_Field (Is_Sig)));
            when others =>
               raise Internal_Error;
         end case;
         --  Extract the range for the dimension.
         Res := New_Selected_Element (Res, Array_Info.T.Bounds_Vector (Dim));
         return New_Address (Res, Index_Info.T.Range_Ptr_Type);
      end Get_Array_Ptr_Range_Ptr;

      function Get_Array_Ptr_Bounds_Ptr
        (Ptr : O_Lnode; Atype : Iir; Is_Sig : Object_Kind_Type)
        return O_Enode
      is
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Atype);
         case Info.Type_Mode is
            when Type_Mode_Fat_Array =>
               return New_Value
                 (New_Selected_Element (New_Acc_Value (Ptr),
                                        Info.T.Bounds_Field (Is_Sig)));
            when Type_Mode_Array =>
               return New_Address (Get_Var (Info.T.Array_Bounds),
                                   Info.T.Bounds_Ptr_Type);
            when others =>
               raise Internal_Error;
         end case;
      end Get_Array_Ptr_Bounds_Ptr;

      function Get_Array_Bounds_Ptr
        (Arr : O_Lnode; Arr_Type : Iir; Is_Sig : Object_Kind_Type)
        return O_Enode
      is
         Type_Info : Type_Info_Acc;
      begin
         Type_Info := Get_Info (Arr_Type);
         case Type_Info.Type_Mode is
            when Type_Mode_Fat_Array =>
               return New_Value (New_Selected_Element
                                 (Arr, Type_Info.T.Bounds_Field (Is_Sig)));
            when Type_Mode_Array =>
               return New_Address (Get_Var (Type_Info.T.Array_Bounds),
                                   Type_Info.T.Bounds_Ptr_Type);
            when others =>
               --  Not an array!
               raise Internal_Error;
         end case;
      end Get_Array_Bounds_Ptr;

      procedure Allocate_Fat_Array_Base (Alloc_Kind : Allocation_Kind;
                                         Res : Mnode;
                                         Arr_Type : Iir)
      is
         Dinfo : Type_Info_Acc;
         Length : O_Enode;
         Kind : constant Object_Kind_Type := Get_Object_Kind (Res);
      begin
         Dinfo := Get_Info (Get_Base_Type (Arr_Type));
         --  Compute array size.
         Length := Get_Object_Size (Res, Arr_Type);
         --  Allocate the storage for the elements.
         New_Assign_Stmt
           (M2Lp (Chap3.Get_Array_Base (Res)),
            Gen_Alloc (Alloc_Kind, Length, Dinfo.T.Base_Ptr_Type (Kind)));

         if Is_Complex_Type (Dinfo)
           and then Dinfo.C (Kind).Builder_Need_Func
         then
            Open_Temp;
            --  Build the type.
            Chap3.Gen_Call_Type_Builder (Res, Arr_Type);
            Close_Temp;
         end if;
      end Allocate_Fat_Array_Base;

      procedure Create_Array_Subtype (Sub_Type : Iir; Transient : Boolean)
      is
         Mark : Id_Mark_Type;
      begin
         Push_Identifier_Prefix_Uniq (Mark);
         if Get_Info (Sub_Type) = null then
            --  Minimal subtype creation.
            Translate_Type_Definition (Sub_Type, False);
            if Transient then
               Add_Transient_Type_In_Temp (Sub_Type);
            end if;
         end if;
         --  Force creation of variables.
         Chap3.Create_Array_Subtype_Bounds_Var (Sub_Type, True);
         Chap3.Create_Type_Definition_Size_Var (Sub_Type);
         Pop_Identifier_Prefix (Mark);
      end Create_Array_Subtype;

      --  Copy SRC to DEST.
      --  Both have the same type, OTYPE.
      procedure Translate_Object_Copy (Dest : Mnode;
                                       Src : O_Enode;
                                       Obj_Type : Iir)
      is
         Info : constant Type_Info_Acc := Get_Info (Obj_Type);
         Kind : constant Object_Kind_Type := Get_Object_Kind (Dest);
         D : Mnode;
      begin
         case Info.Type_Mode is
            when Type_Mode_Scalar
              | Type_Mode_Acc
              | Type_Mode_File =>
               --  Scalar or thin pointer.
               New_Assign_Stmt (M2Lv (Dest), Src);
            when Type_Mode_Fat_Acc =>
               --  a fat pointer.
               declare
                  Var_S : O_Dnode;
                  Var_D : O_Dnode;
               begin
                  Var_S := Create_Temp_Init (Info.Ortho_Ptr_Type (Kind),
                                             Src);
                  Var_D := Create_Temp_Init (Info.Ortho_Ptr_Type (Kind),
                                             M2Addr (Dest));
                  Copy_Fat_Access (Var_D, Var_S, Get_Base_Type (Obj_Type));
               end;
            when Type_Mode_Fat_Array =>
               --  a fat array.
               D := Stabilize (Dest);
               Gen_Memcpy (M2Addr (Get_Array_Base (D)),
                           M2Addr (Get_Array_Base (E2M (Src, Info, Kind))),
                           Get_Object_Size (D, Obj_Type));
            when Type_Mode_Array
              | Type_Mode_Record =>
               D := Stabilize (Dest);
               Gen_Memcpy (M2Addr (D), Src, Get_Object_Size (D, Obj_Type));
            when Type_Mode_Unknown
              | Type_Mode_Protected =>
               raise Internal_Error;
         end case;
      end Translate_Object_Copy;

      function Get_Object_Size (Obj : Mnode; Obj_Type : Iir)
        return O_Enode
      is
         Type_Info : Type_Info_Acc;
         Kind : Object_Kind_Type;
      begin
         Type_Info := Get_Type_Info (Obj);
         Kind := Get_Object_Kind (Obj);
         if Is_Complex_Type (Type_Info)
           and then Type_Info.C (Kind).Size_Var /= null
         then
            return New_Value (Get_Var (Type_Info.C (Kind).Size_Var));
         end if;
         case Type_Info.Type_Mode is
            when Type_Mode_Non_Composite
              | Type_Mode_Array
              | Type_Mode_Record =>
               return New_Lit (New_Sizeof (Type_Info.Ortho_Type (Kind),
                                           Ghdl_Index_Type));
            when Type_Mode_Fat_Array =>
               declare
                  El_Type : Iir;
                  El_Tinfo : Type_Info_Acc;
                  Obj_Bt : Iir;
                  Sz : O_Enode;
               begin
                  Obj_Bt := Get_Base_Type (Obj_Type);
                  El_Type := Get_Element_Subtype (Obj_Bt);
                  El_Tinfo := Get_Info (El_Type);
                  --  See create_type_definition_size_var.
                  Sz := Get_Object_Size (T2M (El_Type, Kind), El_Type);
                  if Is_Complex_Type (El_Tinfo) then
                     Sz := New_Dyadic_Op
                       (ON_Add_Ov,
                        Sz,
                        New_Lit (New_Sizeof (El_Tinfo.Ortho_Ptr_Type (Kind),
                                             Ghdl_Index_Type)));
                  end if;
                  return New_Dyadic_Op
                    (ON_Mul_Ov, Chap3.Get_Array_Length (Obj, Obj_Bt), Sz);
               end;
            when others =>
               raise Internal_Error;
         end case;
      end Get_Object_Size;

      procedure Translate_Object_Allocation
        (Res : in out Mnode;
         Alloc_Kind : Allocation_Kind;
         Obj_Type : Iir;
         Bounds : O_Enode)
      is
         Dinfo : Type_Info_Acc;
         Kind : Object_Kind_Type;
      begin
         Dinfo := Get_Info (Obj_Type);
         Kind := Get_Object_Kind (Res);
         if Dinfo.Type_Mode = Type_Mode_Fat_Array then
            --  Allocate memory for bounds.
            New_Assign_Stmt
              (M2Lp (Chap3.Get_Array_Bounds (Res)),
               Gen_Alloc (Alloc_Kind,
                          New_Lit (New_Sizeof (Dinfo.T.Bounds_Type,
                                               Ghdl_Index_Type)),
                          Dinfo.T.Bounds_Ptr_Type));

            --  Copy bounds to the allocated area.
            Gen_Memcpy
              (M2Addr (Chap3.Get_Array_Bounds (Res)),
               Bounds,
               New_Lit (New_Sizeof (Dinfo.T.Bounds_Type, Ghdl_Index_Type)));

            --  Allocate base.
            Allocate_Fat_Array_Base (Alloc_Kind, Res, Obj_Type);
         else
            New_Assign_Stmt
              (M2Lp (Res),
               Gen_Alloc
               (Alloc_Kind,
                Chap3.Get_Object_Size (T2M (Obj_Type, Kind),
                                       Obj_Type),
                Dinfo.Ortho_Ptr_Type (Kind)));

            if Is_Complex_Type (Dinfo)
              and then Dinfo.C (Kind).Builder_Need_Func
            then
               Open_Temp;
               --  Build the type.
               Chap3.Gen_Call_Type_Builder (Res, Obj_Type);
               Close_Temp;
            end if;

         end if;
      end Translate_Object_Allocation;

      procedure Gen_Deallocate (Obj : O_Enode)
      is
         Assocs : O_Assoc_List;
      begin
         Start_Association (Assocs, Ghdl_Deallocate);
         New_Association (Assocs, New_Convert_Ov (Obj, Ghdl_Ptr_Type));
         New_Procedure_Call (Assocs);
      end Gen_Deallocate;

      --  Performs deallocation of PARAM (the parameter of a deallocate call).
      procedure Translate_Object_Deallocation (Param : Iir)
      is
         --  Performs deallocation of field FIELD of type FTYPE of PTR.
         --  If FIELD is O_FNODE_NULL, deallocate PTR (of type FTYPE).
         --  Here, deallocate means freeing memory and clearing to null.
         procedure Deallocate_1
           (Ptr : Mnode; Field : O_Fnode; Ftype : O_Tnode)
         is
            L : O_Lnode;
         begin
            for I in 0 .. 1 loop
               L := M2Lv (Ptr);
               if Field /= O_Fnode_Null then
                  L := New_Selected_Element (L, Field);
               end if;
               case I is
                  when 0 =>
                     --  Call deallocator.
                     Gen_Deallocate (New_Value (L));
                  when 1 =>
                     --  set the value to 0.
                     New_Assign_Stmt (L, New_Lit (New_Null_Access (Ftype)));
               end case;
            end loop;
         end Deallocate_1;

         Param_Type : Iir;
         Val : Mnode;
         Info : Type_Info_Acc;
         Binfo : Type_Info_Acc;
      begin
         --  Compute parameter
         Val := Chap6.Translate_Name (Param);
         if Get_Object_Kind (Val) = Mode_Signal then
            raise Internal_Error;
         end if;
         Stabilize (Val);
         Param_Type := Get_Type (Param);
         Info := Get_Info (Param_Type);
         case Info.Type_Mode is
            when Type_Mode_Fat_Acc =>
               --  This is a fat pointer.
               --  Deallocate base and bounds.
               Binfo := Get_Info (Get_Designated_Type (Param_Type));
               Deallocate_1 (Val, Binfo.T.Base_Field (Mode_Value),
                             Binfo.T.Base_Ptr_Type (Mode_Value));
               Deallocate_1 (Val, Binfo.T.Bounds_Field (Mode_Value),
                             Binfo.T.Bounds_Ptr_Type);
            when Type_Mode_Acc =>
               --  This is a thin pointer.
               Deallocate_1 (Val, O_Fnode_Null,
                             Info.Ortho_Type (Mode_Value));
            when others =>
               raise Internal_Error;
         end case;
      end Translate_Object_Deallocation;

      function Not_In_Range (Value : O_Dnode; Atype : Iir) return O_Enode
      is
         Constr : Iir;
         Info : Type_Info_Acc;

         function Gen_Compare (Low : O_Enode; Hi : O_Enode) return O_Enode
         is
            L, H : O_Enode;
         begin
            if not Info.T.Nocheck_Low then
               L := New_Compare_Op
                 (ON_Lt, New_Obj_Value (Value), Low, Ghdl_Bool_Type);
            end if;
            if not Info.T.Nocheck_Hi then
               H := New_Compare_Op
                 (ON_Gt, New_Obj_Value (Value), Hi, Ghdl_Bool_Type);
            end if;
            if Info.T.Nocheck_Hi then
               if Info.T.Nocheck_Low then
                  --  Should not happen!
                  return New_Lit (Ghdl_Bool_False_Node);
               else
                  return L;
               end if;
            else
               if Info.T.Nocheck_Low then
                  return H;
               else
                  return New_Dyadic_Op (ON_Or, L, H);
               end if;
            end if;
         end Gen_Compare;

         function Gen_Compare_To return O_Enode is
         begin
            return Gen_Compare
              (Chap14.Translate_Left_Type_Attribute (Atype),
               Chap14.Translate_Right_Type_Attribute (Atype));
         end Gen_Compare_To;

         function Gen_Compare_Downto return O_Enode is
         begin
            return Gen_Compare
              (Chap14.Translate_Right_Type_Attribute (Atype),
               Chap14.Translate_Left_Type_Attribute (Atype));
         end Gen_Compare_Downto;

         --Low, High : Iir;
         Var_Res : O_Dnode;
         If_Blk : O_If_Block;
      begin
         Constr := Get_Range_Constraint (Atype);
         Info := Get_Info (Atype);

         if Get_Kind (Constr) = Iir_Kind_Range_Expression then
            --  Constraint is a range expression, therefore, direction is
            --  known.
            if Get_Expr_Staticness (Constr) = Locally then
               --  Range constraint is locally static
               --  FIXME: check low and high if they are not limits...
               --Low := Get_Low_Limit (Constr);
               --High := Get_High_Limit (Constr);
               null;
            end if;
            case Get_Direction (Constr) is
               when Iir_To =>
                  return Gen_Compare_To;
               when Iir_Downto =>
                  return Gen_Compare_Downto;
            end case;
         end if;

         --  Range constraint is not static
         --    full check (lot's of code ?).
         Var_Res := Create_Temp (Ghdl_Bool_Type);
         Start_If_Stmt
           (If_Blk,
            New_Compare_Op (ON_Eq,
                            Chap14.Translate_Dir_Type_Attribute (Atype),
                            New_Lit (Ghdl_Dir_To_Node),
                            Ghdl_Bool_Type));
         --  To.
         New_Assign_Stmt (New_Obj (Var_Res), Gen_Compare_To);
         New_Else_Stmt (If_Blk);
         --  Downto
         New_Assign_Stmt (New_Obj (Var_Res), Gen_Compare_Downto);
         Finish_If_Stmt (If_Blk);
         return New_Obj_Value (Var_Res);
      end Not_In_Range;

      function Need_Range_Check (Expr : Iir; Atype : Iir) return Boolean
      is
         Info : constant Type_Info_Acc := Get_Info (Atype);
      begin
         if Info.T.Nocheck_Low and Info.T.Nocheck_Hi then
            return False;
         end if;
         if Expr /= Null_Iir and then Get_Type (Expr) = Atype then
            return False;
         end if;
         return True;
      end Need_Range_Check;

      procedure Check_Range
        (Value : O_Dnode; Expr : Iir; Atype : Iir; Loc : Iir)
      is
         If_Blk : O_If_Block;
      begin
         if not Need_Range_Check (Expr, Atype) then
            return;
         end if;

         if Expr /= Null_Iir
           and then Get_Expr_Staticness (Expr) = Locally
           and then Get_Type_Staticness (Atype) = Locally
         then
            if not Eval_Is_In_Bound (Eval_Static_Expr (Expr), Atype) then
               Chap6.Gen_Bound_Error (Loc);
            end if;
         else
            Open_Temp;
            Start_If_Stmt (If_Blk, Not_In_Range (Value, Atype));
            Chap6.Gen_Bound_Error (Loc);
            Finish_If_Stmt (If_Blk);
            Close_Temp;
         end if;
      end Check_Range;

      function Insert_Scalar_Check
        (Value : O_Enode; Expr : Iir; Atype : Iir; Loc : Iir)
        return O_Enode
      is
         Var : O_Dnode;
      begin
         Var := Create_Temp_Init
           (Get_Ortho_Type (Get_Base_Type (Atype), Mode_Value), Value);
         Check_Range (Var, Expr, Atype, Loc);
         return New_Obj_Value (Var);
      end Insert_Scalar_Check;

      function Maybe_Insert_Scalar_Check
        (Value : O_Enode; Expr : Iir; Atype : Iir)
        return O_Enode
      is
         Expr_Type : constant Iir := Get_Type (Expr);
      begin
         --  pragma Assert (Base_Type = Get_Base_Type (Atype));
         if Get_Kind (Expr_Type) in Iir_Kinds_Scalar_Type_Definition
           and then Need_Range_Check (Expr, Atype)
         then
            return Insert_Scalar_Check (Value, Expr, Atype, Expr);
         else
            return Value;
         end if;
      end Maybe_Insert_Scalar_Check;

      procedure Check_Array_Match (L_Type : Iir;
                                   L_Node : Mnode;
                                   R_Type : Iir;
                                   R_Node : Mnode;
                                   Loc : Iir)
      is
         L_Tinfo, R_Tinfo : Type_Info_Acc;
      begin
         L_Tinfo := Get_Info (L_Type);
         R_Tinfo := Get_Info (R_Type);
         --  FIXME: optimize for a statically bounded array of a complex type.
         if L_Tinfo.Type_Mode = Type_Mode_Array
           and then L_Tinfo.Type_Locally_Constrained
           and then R_Tinfo.Type_Mode = Type_Mode_Array
           and then R_Tinfo.Type_Locally_Constrained
         then
            --  Both left and right are thin array.
            --  Check here the length are the same.
            declare
               L_Indexes : Iir_List;
               R_Indexes : Iir_List;
               L_El : Iir;
               R_El : Iir;
               Err : Boolean;
            begin
               L_Indexes := Get_Index_Subtype_List (L_Type);
               R_Indexes := Get_Index_Subtype_List (R_Type);
               Err := False;
               for I in Natural loop
                  L_El := Get_Index_Type (L_Indexes, I);
                  R_El := Get_Index_Type (R_Indexes, I);
                  exit when L_El = Null_Iir and R_El = Null_Iir;
                  if Eval_Discrete_Type_Length (L_El)
                    /= Eval_Discrete_Type_Length (R_El)
                  then
                     if not Err then
                        Chap6.Gen_Bound_Error (Loc);
                        Err := True;
                     end if;
                  end if;
               end loop;
            end;
         else
            --  Check length match.
            declare
               Index_List : constant Iir_List :=
                 Get_Index_Subtype_List (L_Type);
               Index : Iir;
               Cond : O_Enode;
               Sub_Cond : O_Enode;
            begin
               for I in Natural loop
                  Index := Get_Nth_Element (Index_List, I);
                  exit when Index = Null_Iir;
                  Sub_Cond := New_Compare_Op
                    (ON_Neq,
                     M2E (Range_To_Length
                          (Get_Array_Range (L_Node, L_Type, I + 1))),
                     M2E (Range_To_Length
                          (Get_Array_Range (R_Node, R_Type, I + 1))),
                     Ghdl_Bool_Type);
                  if I = 0 then
                     Cond := Sub_Cond;
                  else
                     Cond := New_Dyadic_Op (ON_Or, Cond, Sub_Cond);
                  end if;
               end loop;
               Chap6.Check_Bound_Error (Cond, Loc, 0);
            end;
         end if;
      end Check_Array_Match;

      procedure Create_Range_From_Array_Attribute_And_Length
        (Array_Attr : Iir; Length : O_Dnode; Range_Ptr : O_Dnode)
      is
         Attr_Kind : Iir_Kind;
         Arr_Rng : Mnode;
         Iinfo : Type_Info_Acc;

         Res : Mnode;

         Dir : O_Enode;
         Diff : O_Dnode;
         Left_Bound : Mnode;
         If_Blk : O_If_Block;
         If_Blk1 : O_If_Block;
      begin
         Open_Temp;
         Arr_Rng := Chap14.Translate_Array_Attribute_To_Range (Array_Attr);
         Iinfo := Get_Type_Info (Arr_Rng);
         Stabilize (Arr_Rng);

         Res := Dp2M (Range_Ptr, Iinfo, Mode_Value);

         --  Length.
         New_Assign_Stmt (M2Lv (Range_To_Length (Arr_Rng)),
                          New_Obj_Value (Length));

         --  Direction.
         Attr_Kind := Get_Kind (Array_Attr);
         Dir := M2E (Range_To_Dir (Arr_Rng));
         case Attr_Kind is
            when Iir_Kind_Range_Array_Attribute =>
               New_Assign_Stmt (M2Lv (Range_To_Dir (Res)), Dir);
            when Iir_Kind_Reverse_Range_Array_Attribute =>
               Start_If_Stmt (If_Blk,
                              New_Compare_Op (ON_Eq,
                                              Dir,
                                              New_Lit (Ghdl_Dir_To_Node),
                                              Ghdl_Bool_Type));
               New_Assign_Stmt
                 (M2Lv (Range_To_Dir (Res)), New_Lit (Ghdl_Dir_Downto_Node));
               New_Else_Stmt (If_Blk);
               New_Assign_Stmt
                 (M2Lv (Range_To_Dir (Res)), New_Lit (Ghdl_Dir_To_Node));
               Finish_If_Stmt (If_Blk);
            when others =>
               Error_Kind ("Create_Range_From_Array_Attribute_And_Length",
                           Array_Attr);
         end case;

         Start_If_Stmt
           (If_Blk,
            New_Compare_Op (ON_Eq,
                            New_Obj_Value (Length),
                            New_Lit (Ghdl_Index_0),
                            Ghdl_Bool_Type));
         --  Null range.
         case Attr_Kind is
            when Iir_Kind_Range_Array_Attribute =>
               New_Assign_Stmt (M2Lv (Range_To_Left (Res)),
                                M2E (Range_To_Right (Arr_Rng)));
               New_Assign_Stmt (M2Lv (Range_To_Right (Res)),
                                M2E (Range_To_Left (Arr_Rng)));
            when Iir_Kind_Reverse_Range_Array_Attribute =>
               New_Assign_Stmt (M2Lv (Range_To_Left (Res)),
                                M2E (Range_To_Left (Arr_Rng)));
               New_Assign_Stmt (M2Lv (Range_To_Right (Res)),
                                M2E (Range_To_Right (Arr_Rng)));
            when others =>
               raise Internal_Error;
         end case;

         New_Else_Stmt (If_Blk);

         --  LEFT.
         case Attr_Kind is
            when Iir_Kind_Range_Array_Attribute =>
               Left_Bound := Range_To_Left (Arr_Rng);
            when Iir_Kind_Reverse_Range_Array_Attribute =>
               Left_Bound := Range_To_Right (Arr_Rng);
            when others =>
               raise Internal_Error;
         end case;
         Stabilize (Left_Bound);
         New_Assign_Stmt (M2Lv (Range_To_Left (Res)), M2E (Left_Bound));

         --  RIGHT.
         Diff := Create_Temp_Init
           (Iinfo.Ortho_Type (Mode_Value),
            New_Convert_Ov
            (New_Dyadic_Op (ON_Sub_Ov,
                            New_Obj_Value (Length),
                            New_Lit (Ghdl_Index_1)),
             Iinfo.Ortho_Type (Mode_Value)));

         Start_If_Stmt (If_Blk1, New_Compare_Op (ON_Eq,
                                                 M2E (Range_To_Dir (Res)),
                                                 New_Lit (Ghdl_Dir_To_Node),
                                                 Ghdl_Bool_Type));
         New_Assign_Stmt (M2Lv (Range_To_Right (Res)),
                          New_Dyadic_Op (ON_Add_Ov,
                                         M2E (Left_Bound),
                                         New_Obj_Value (Diff)));
         New_Else_Stmt (If_Blk1);
         New_Assign_Stmt (M2Lv (Range_To_Right (Res)),
                          New_Dyadic_Op (ON_Sub_Ov,
                                         M2E (Left_Bound),
                                         New_Obj_Value (Diff)));
         Finish_If_Stmt (If_Blk1);

         --  FIXME: check right bounds is inside bounds.
         Finish_If_Stmt (If_Blk);
         Close_Temp;
      end Create_Range_From_Array_Attribute_And_Length;

      procedure Create_Range_From_Length
        (Index_Type : Iir; Length : O_Dnode; Range_Ptr : O_Dnode; Loc : Iir)
      is
         Iinfo : constant Type_Info_Acc := Get_Info (Index_Type);
         Range_Constr : constant Iir := Get_Range_Constraint (Index_Type);
         Op : ON_Op_Kind;
         Diff : O_Enode;
         Left_Bound : O_Enode;
         Var_Right : O_Dnode;
         If_Blk : O_If_Block;
      begin
         if Get_Kind (Range_Constr) /= Iir_Kind_Range_Expression then
            Create_Range_From_Array_Attribute_And_Length
              (Range_Constr, Length, Range_Ptr);
            return;
         end if;

         Start_Declare_Stmt;
         New_Var_Decl (Var_Right, Get_Identifier ("right_bound"),
                       O_Storage_Local, Iinfo.Ortho_Type (Mode_Value));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Range_Ptr), Iinfo.T.Range_Length),
            New_Obj_Value (Length));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Range_Ptr), Iinfo.T.Range_Dir),
            New_Lit (Chap7.Translate_Static_Range_Dir (Range_Constr)));

         case Get_Direction (Range_Constr) is
            when Iir_To =>
               Op := ON_Add_Ov;
            when Iir_Downto =>
               Op := ON_Sub_Ov;
         end case;

         Start_If_Stmt
           (If_Blk,
            New_Compare_Op (ON_Eq,
                            New_Obj_Value (Length),
                            New_Lit (Ghdl_Index_0),
                            Ghdl_Bool_Type));
         --  Null range.
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Range_Ptr), Iinfo.T.Range_Left),
            Chap7.Translate_Range_Expression_Right (Range_Constr, Index_Type));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Range_Ptr), Iinfo.T.Range_Right),
            Chap7.Translate_Range_Expression_Left (Range_Constr, Index_Type));

         New_Else_Stmt (If_Blk);
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Range_Ptr), Iinfo.T.Range_Left),
            Chap7.Translate_Range_Expression_Left (Range_Constr, Index_Type));
         Left_Bound := Chap7.Translate_Range_Expression_Left
           (Range_Constr, Index_Type);
         Diff := New_Convert_Ov
           (New_Dyadic_Op (ON_Sub_Ov,
                           New_Obj_Value (Length),
                           New_Lit (Ghdl_Index_1)),
            Iinfo.Ortho_Type (Mode_Value));
         New_Assign_Stmt (New_Obj (Var_Right),
                          New_Dyadic_Op (Op, Left_Bound, Diff));

         --   Check the right bounds is inside the bounds of the index type.
         Chap3.Check_Range (Var_Right, Null_Iir, Index_Type, Loc);
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Range_Ptr), Iinfo.T.Range_Right),
            New_Obj_Value (Var_Right));
         Finish_If_Stmt (If_Blk);
         Finish_Declare_Stmt;
      end Create_Range_From_Length;
   end Chap3;

   package body Chap4 is
      --  Get the ortho type for an object of mode MODE.
      function Get_Object_Type (Tinfo : Type_Info_Acc; Kind : Object_Kind_Type)
        return O_Tnode is
      begin
         if Is_Complex_Type (Tinfo) then
            case Tinfo.Type_Mode is
               when Type_Mode_Fat_Array =>
                  return Tinfo.Ortho_Type (Kind);
               when Type_Mode_Record
                 | Type_Mode_Array
                 | Type_Mode_Protected =>
                  --  For a complex type, use a pointer.
                  return Tinfo.Ortho_Ptr_Type (Kind);
               when others =>
                  raise Internal_Error;
            end case;
         else
            return Tinfo.Ortho_Type (Kind);
         end if;
      end Get_Object_Type;

      procedure Create_Object (El : Iir)
      is
         Obj_Type : O_Tnode;
         Info : Object_Info_Acc;
         Tinfo : Type_Info_Acc;
         Def : Iir;
         Val : Iir;
         Storage : O_Storage;
         Deferred : Iir;
      begin
         Def := Get_Type (El);
         Val := Get_Default_Value (El);

         --  Be sure the object type was translated.
         if Get_Kind (El) = Iir_Kind_Constant_Declaration
           and then Get_Deferred_Declaration_Flag (El) = False
           and then Get_Deferred_Declaration (El) /= Null_Iir
         then
            --  This is a full constant declaration which complete a previous
            --  incomplete constant declaration.
            --
            --  Do not create the subtype of this full constant declaration,
            --  since it was already created by the deferred declaration.
            --  Use the type of the deferred declaration.
            Deferred := Get_Deferred_Declaration (El);
            Def := Get_Type (Deferred);
            Info := Get_Info (Deferred);
            Set_Info (El, Info);
         else
            Chap3.Translate_Object_Subtype (El);
            Info := Add_Info (El, Kind_Object);
         end if;

         Tinfo := Get_Info (Def);
         Obj_Type := Get_Object_Type (Tinfo, Mode_Value);

         case Get_Kind (El) is
            when Iir_Kind_Variable_Declaration
              | Iir_Kind_Constant_Interface_Declaration =>
               Info.Object_Var := Create_Var (Create_Var_Identifier (El),
                                              Obj_Type);
            when Iir_Kind_Constant_Declaration =>
               if Get_Deferred_Declaration (El) /= Null_Iir then
                  --  This is a full constant declaration (in a body) of a
                  --  deferred constant declaration (in a package).
                  Storage := O_Storage_Public;
               else
                  Storage := Global_Storage;
               end if;
               if Info.Object_Var = null then
                  --  Not a full constant declaration (ie a value for an
                  --   already declared constant).
                  --  Must create the declaration.
                  if Chap7.Is_Static_Constant (El) then
                     Info.Object_Static := True;
                     Info.Object_Var := Create_Global_Const
                       (Create_Identifier (El), Obj_Type, Global_Storage,
                        O_Cnode_Null);
                  else
                     Info.Object_Static := False;
                     Info.Object_Var := Create_Var
                       (Create_Var_Identifier (El), Obj_Type, Global_Storage);
                  end if;
               end if;
               if Get_Deferred_Declaration (El) = Null_Iir
                 and then Info.Object_Static
                 and then Storage /= O_Storage_External
               then
                  --  Deferred constant are never considered as locally static.
                  --  FIXME: to be improved ?

                  --  open_temp/close_temp only required for transient types.
                  Open_Temp;
                  Define_Global_Const
                    (Info.Object_Var,
                     Chap7.Translate_Static_Expression (Val, Def));
                  Close_Temp;
               end if;
            when others =>
               Error_Kind ("create_objet", El);
         end case;
      end Create_Object;

      procedure Create_Signal (Decl : Iir)
      is
         Sig_Type : O_Tnode;
         Type_Info : Type_Info_Acc;
         Info : Ortho_Info_Acc;
         Sig_Type_Def : Iir;
      begin
         Sig_Type_Def := Get_Type (Decl);
         Chap3.Translate_Object_Subtype (Decl);
         Type_Info := Get_Info (Sig_Type_Def);
         Sig_Type := Get_Object_Type (Type_Info, Mode_Signal);
         if Sig_Type = O_Tnode_Null then
            raise Internal_Error;
         end if;

         Info := Add_Info (Decl, Kind_Object);

         Info.Object_Var := Create_Var
           (Create_Var_Identifier (Decl), Sig_Type);

         case Get_Kind (Decl) is
            when Iir_Kind_Signal_Declaration
              | Iir_Kind_Signal_Interface_Declaration =>
               Rtis.Generate_Signal_Rti (Decl);
            when Iir_Kind_Guard_Signal_Declaration =>
               --  No name created for guard signal.
               null;
            when others =>
               Error_Kind ("create_signal", Decl);
         end case;
      end Create_Signal;

      procedure Create_Implicit_Signal (Decl : Iir)
      is
         Sig_Type : O_Tnode;
         Type_Info : Type_Info_Acc;
         Info : Ortho_Info_Acc;
         Sig_Type_Def : Iir;
      begin
         Sig_Type_Def := Get_Type (Decl);
         --  This has been disabled since DECL can have an anonymous subtype,
         --  and DECL has no identifiers, which causes translate_object_subtype
         --  to crash.
         --  Note: DECL can only be a iir_kind_delayed_attribute.
         --Chap3.Translate_Object_Subtype (Decl);
         Type_Info := Get_Info (Sig_Type_Def);
         Sig_Type := Type_Info.Ortho_Type (Mode_Signal);
         if Sig_Type = O_Tnode_Null then
            raise Internal_Error;
         end if;

         Info := Add_Info (Decl, Kind_Object);

         Info.Object_Var := Create_Var (Create_Uniq_Identifier, Sig_Type);
      end Create_Implicit_Signal;

      procedure Create_File_Object (El : Iir_File_Declaration)
      is
         Obj_Type : O_Tnode;
         Info : Ortho_Info_Acc;
         Obj_Type_Def : Iir;
      begin
         Obj_Type_Def := Get_Type (El);
         Obj_Type := Get_Ortho_Type (Obj_Type_Def, Mode_Value);

         Info := Add_Info (El, Kind_Object);

         Info.Object_Var := Create_Var (Create_Var_Identifier (El), Obj_Type);
      end Create_File_Object;

      procedure Allocate_Complex_Object (Obj_Type : Iir;
                                         Alloc_Kind : Allocation_Kind;
                                         Var : in out Mnode)
      is
         Type_Info : constant Type_Info_Acc := Get_Type_Info (Var);
         Kind : constant Object_Kind_Type := Get_Object_Kind (Var);
         Targ : Mnode;
      begin
         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
            --  Cannot allocate unconstrained object (since size is unknown).
            raise Internal_Error;
         end if;

         if not Is_Complex_Type (Type_Info) then
            --  Object is not complex.
            return;
         end if;

         if Type_Info.C (Kind).Builder_Need_Func
           and then not Is_Stable (Var)
         then
            Targ := Create_Temp (Type_Info, Kind);
         else
            Targ := Var;
         end if;

         --  Allocate variable.
         New_Assign_Stmt
           (M2Lp (Targ),
            Gen_Alloc (Alloc_Kind,
                       Chap3.Get_Object_Size (Var, Obj_Type),
                       Type_Info.Ortho_Ptr_Type (Kind)));

         if Type_Info.C (Kind).Builder_Need_Func then
            --  Build the type.
            Chap3.Gen_Call_Type_Builder (Targ, Obj_Type);
            if not Is_Stable (Var) then
               New_Assign_Stmt (M2Lp (Var), M2Addr (Targ));
               Var := Targ;
            end if;
         end if;
      end Allocate_Complex_Object;

      --  Note : OBJ can be a tree.
      --  FIXME: should use translate_aggregate_others.
      procedure Init_Array_Object (Obj : Mnode; Obj_Type : Iir)
      is
         Sobj : Mnode;

         --  Type of the object.
         Type_Info : Type_Info_Acc;

         --  Iterator for the elements.
         Index : O_Dnode;

         Upper_Limit : O_Enode;
         Upper_Var : O_Dnode;

         Label : O_Snode;
      begin
         Type_Info := Get_Info (Obj_Type);

         --  Iterate on all elements of the object.
         Open_Temp;

         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
            Sobj := Stabilize (Obj);
         else
            Sobj := Obj;
         end if;
         Upper_Limit := Chap3.Get_Array_Length (Sobj, Obj_Type);

         if Type_Info.Type_Mode /= Type_Mode_Array then
            Upper_Var := Create_Temp_Init (Ghdl_Index_Type, Upper_Limit);
         else
            Upper_Var := O_Dnode_Null;
         end if;

         Index := Create_Temp (Ghdl_Index_Type);
         Init_Var (Index);
         Start_Loop_Stmt (Label);
         if Upper_Var /= O_Dnode_Null then
            Upper_Limit := New_Obj_Value (Upper_Var);
         end if;
         Gen_Exit_When (Label,
                        New_Compare_Op (ON_Eq,
                                        New_Obj_Value (Index), Upper_Limit,
                                        Ghdl_Bool_Type));
         Init_Object (Chap3.Index_Base (Chap3.Get_Array_Base (Sobj),
                                        Obj_Type,
                                        New_Obj_Value (Index)),
                      Get_Element_Subtype (Obj_Type));
         Inc_Var (Index);
         Finish_Loop_Stmt (Label);

         Close_Temp;
      end Init_Array_Object;

      procedure Init_Protected_Object (Obj : Mnode; Obj_Type : Iir)
      is
         Assoc : O_Assoc_List;
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Obj_Type);

         --  Call the initializer.
         Start_Association (Assoc, Info.T.Prot_Init_Subprg);
         Chap2.Add_Subprg_Instance_Assoc (Assoc, Info.T.Prot_Init_Instance);
         --  Use of M2Lp is a little bit fragile (not sure we get the
         --  variable, but should work: we didn't stabilize it).
         New_Assign_Stmt (M2Lp (Obj), New_Function_Call (Assoc));
      end Init_Protected_Object;

      procedure Fini_Protected_Object (Decl : Iir)
      is
         Obj : Mnode;
         Assoc : O_Assoc_List;
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Get_Type (Decl));

         Obj := Chap6.Translate_Name (Decl);
         --  Call the Finalizator.
         Start_Association (Assoc, Info.T.Prot_Final_Subprg);
         New_Association (Assoc, M2E (Obj));
         New_Procedure_Call (Assoc);
      end Fini_Protected_Object;

      procedure Init_Object (Obj : Mnode; Obj_Type : Iir)
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Type_Info (Obj);
         case Tinfo.Type_Mode is
            when Type_Mode_Scalar =>
               New_Assign_Stmt
                 (M2Lv (Obj), Chap14.Translate_Left_Type_Attribute (Obj_Type));
            when Type_Mode_Acc =>
               New_Assign_Stmt
                 (M2Lv (Obj),
                  New_Lit (New_Null_Access (Tinfo.Ortho_Type (Mode_Value))));
            when Type_Mode_Fat_Acc =>
               declare
                  Dinfo : Type_Info_Acc;
                  Sobj : Mnode;
               begin
                  Open_Temp;
                  Sobj := Stabilize (Obj);
                  Dinfo := Get_Info (Get_Designated_Type (Obj_Type));
                  New_Assign_Stmt
                    (New_Selected_Element (M2Lv (Sobj),
                                           Dinfo.T.Bounds_Field (Mode_Value)),
                     New_Lit (New_Null_Access (Dinfo.T.Bounds_Ptr_Type)));
                  New_Assign_Stmt
                    (New_Selected_Element (M2Lv (Sobj),
                                           Dinfo.T.Base_Field (Mode_Value)),
                     New_Lit (New_Null_Access
                              (Dinfo.T.Base_Ptr_Type (Mode_Value))));
                  Close_Temp;
               end;
            when Type_Mode_Arrays =>
               Init_Array_Object (Obj, Obj_Type);
            when Type_Mode_Record =>
               declare
                  Sobj : Mnode;
                  El : Iir_Element_Declaration;
                  List : Iir_List;
               begin
                  Open_Temp;
                  Sobj := Stabilize (Obj);
                  List := Get_Elements_Declaration_List
                    (Get_Base_Type (Obj_Type));
                  for I in Natural loop
                     El := Get_Nth_Element (List, I);
                     exit when El = Null_Iir;
                     Init_Object (Chap6.Translate_Selected_Element (Sobj, El),
                                  Get_Type (El));
                  end loop;
                  Close_Temp;
               end;
            when Type_Mode_Protected =>
               Init_Protected_Object (Obj, Obj_Type);
            when Type_Mode_Unknown
              | Type_Mode_File =>
               raise Internal_Error;
         end case;
      end Init_Object;

      procedure Elab_Object_Storage (Obj : Iir)
      is
         Obj_Info : Object_Info_Acc;

         Name_Node : Mnode;
         Obj_Type : Iir;

         Type_Info : Type_Info_Acc;
         Alloc_Kind : Allocation_Kind;
      begin
         --  Elaborate subtype.
         Obj_Type := Get_Type (Obj);
         Chap3.Elab_Object_Subtype (Obj_Type);

         Type_Info := Get_Info (Obj_Type);
         Obj_Info := Get_Info (Obj);

         --  FIXME: the object type may be a fat array!
         --  FIXME: fat array + aggregate ?

         if Type_Info.Type_Mode = Type_Mode_Protected then
            --  Protected object will be created by its INIT function.
            return;
         end if;

         if Is_Complex_Type (Type_Info)
           and then Type_Info.Type_Mode /= Type_Mode_Fat_Array
         then
            --  FIXME: avoid allocation if the value is a string and
            --  the object is a constant
            Name_Node := Get_Var (Obj_Info.Object_Var, Type_Info, Mode_Value);
            Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var);
            Allocate_Complex_Object (Obj_Type, Alloc_Kind, Name_Node);
         end if;
      end Elab_Object_Storage;

      --  Generate code to create object OBJ and initialize it with value VAL.
      procedure Elab_Object_Init (Name : Mnode; Obj : Iir; Value : Iir)
      is
         Obj_Type : constant Iir := Get_Type (Obj);
         Type_Info : constant Type_Info_Acc := Get_Info (Obj_Type);
         Obj_Info : constant Object_Info_Acc := Get_Info (Obj);

         Name_Node : Mnode;
         Value_Node : O_Enode;

         Alloc_Kind : Allocation_Kind;
      begin
         --  Elaborate subtype.
         Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var);

         --  Note: no temporary variable region is created, as the allocation
         --  may be performed on the stack.

         if Value = Null_Iir then
            --  Performs default initialization.
            Open_Temp;
            Init_Object (Name, Obj_Type);
            Close_Temp;
         elsif Get_Kind (Value) = Iir_Kind_Aggregate then
            if Type_Info.Type_Mode = Type_Mode_Fat_Array then
               --  Allocate.
               declare
                  Aggr_Type : Iir;
               begin
                  Aggr_Type := Get_Type (Value);
                  Chap3.Create_Array_Subtype (Aggr_Type, True);
                  Name_Node := Stabilize (Name);
                  New_Assign_Stmt
                    (New_Selected_Element
                     (M2Lv (Name_Node), Type_Info.T.Bounds_Field (Mode_Value)),
                     Chap3.Get_Array_Ptr_Bounds_Ptr (O_Lnode_Null, Aggr_Type,
                                                     Mode_Value));
                  Chap3.Allocate_Fat_Array_Base
                    (Alloc_Kind, Name_Node, Get_Base_Type (Aggr_Type));
               end;
            else
               Name_Node := Name;
            end if;
            Chap7.Translate_Aggregate (Name_Node, Obj_Type, Value);
         else
            Value_Node := Chap7.Translate_Expression (Value, Obj_Type);

            if Type_Info.Type_Mode = Type_Mode_Fat_Array then
               declare
                  S : O_Dnode;
               begin
                  Name_Node := Stabilize (Name);
                  S := Create_Temp_Init
                    (Type_Info.Ortho_Ptr_Type (Mode_Value), Value_Node);

                  if Get_Kind (Value) = Iir_Kind_String_Literal
                    and then Get_Kind (Obj) = Iir_Kind_Constant_Declaration
                  then
                     --  No need to allocate space for the object.
                     Copy_Fat_Pointer (Name_Node,
                                       Dp2M (S, Type_Info, Mode_Value));
                  else
                     Chap3.Translate_Object_Allocation
                       (Name_Node, Alloc_Kind, Obj_Type,
                        Chap3.Get_Array_Ptr_Bounds_Ptr (New_Obj (S),
                                                        Get_Type (Value),
                                                        Mode_Value));
                     Chap3.Translate_Object_Copy
                       (Name_Node, New_Obj_Value (S), Obj_Type);
                  end if;
               end;
            else
               Chap3.Translate_Object_Copy (Name, Value_Node, Obj_Type);
            end if;
            Destroy_Local_Transient_Types;
         end if;
      end Elab_Object_Init;

      --  Generate code to create object OBJ and initialize it with value VAL.
      procedure Elab_Object_Value (Obj : Iir; Value : Iir)
      is
         Name : Mnode;
      begin
         Elab_Object_Storage (Obj);
         Name := Get_Var (Get_Info (Obj).Object_Var,
                          Get_Info (Get_Type (Obj)), Mode_Value);
         Elab_Object_Init (Name, Obj, Value);
      end Elab_Object_Value;

      --  Create code to elaborate OBJ.
      procedure Elab_Object (Obj : Iir)
      is
         Value : Iir;
         Obj1 : Iir;
      begin
         --  A locally static constant is pre-elaborated.
         --  (only constant can be locally static).
         if Get_Expr_Staticness (Obj) = Locally
           and then Get_Deferred_Declaration (Obj) = Null_Iir
         then
            return;
         end if;

         --  Set default value.
         if Get_Kind (Obj) = Iir_Kind_Constant_Declaration then
            if Get_Info (Obj).Object_Static then
               return;
            end if;
            if Get_Deferred_Declaration_Flag (Obj) then
               --  No code generation for a deferred constant.
               return;
            end if;
            Obj1 := Get_Deferred_Declaration (Obj);
            if Obj1 = Null_Iir then
               Obj1 := Obj;
            end if;
         else
            Obj1 := Obj;
         end if;

         New_Debug_Line_Stmt (Get_Line_Number (Obj));

         --  Still use the default value of the not deferred constant.
         --  FIXME: what about composite types.
         Value := Get_Default_Value (Obj);
         Elab_Object_Value (Obj1, Value);
      end Elab_Object;

      procedure Fini_Object (Obj : Iir)
      is
         Obj_Type : Iir;
         Type_Info : Type_Info_Acc;
      begin
         Obj_Type := Get_Type (Obj);
         Type_Info := Get_Info (Obj_Type);
         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
            declare
               V : Mnode;
            begin
               Open_Temp;
               V := Chap6.Translate_Name (Obj);
               Stabilize (V);
               Chap3.Gen_Deallocate
                 (New_Value (M2Lp (Chap3.Get_Array_Bounds (V))));
               Chap3.Gen_Deallocate
                 (New_Value (M2Lp (Chap3.Get_Array_Base (V))));
               Close_Temp;
            end;
         elsif Is_Complex_Type (Type_Info) then
            Chap3.Gen_Deallocate
              (New_Value (M2Lp (Chap6.Translate_Name (Obj))));
         end if;
      end Fini_Object;

      function Get_Nbr_Signals (Sig : Mnode; Sig_Type : Iir) return O_Enode
      is
         Info : constant Type_Info_Acc := Get_Info (Sig_Type);
      begin
         case Info.Type_Mode is
            when Type_Mode_Scalar =>
               --  Note: here we discard SIG...
               return New_Lit (Ghdl_Index_1);
            when Type_Mode_Arrays =>
               declare
                  Len : O_Dnode;
                  If_Blk : O_If_Block;
                  Ssig : Mnode;
               begin
                  Ssig := Stabilize (Sig);
                  Len := Create_Temp_Init
                    (Ghdl_Index_Type,
                     Chap3.Get_Array_Length (Ssig, Sig_Type));
                  Start_If_Stmt (If_Blk,
                                 New_Compare_Op (ON_Neq,
                                                 New_Obj_Value (Len),
                                                 New_Lit (Ghdl_Index_0),
                                                 Ghdl_Bool_Type));
                  New_Assign_Stmt
                    (New_Obj (Len),
                     New_Dyadic_Op
                       (ON_Mul_Ov,
                        New_Obj_Value (Len),
                        Get_Nbr_Signals
                          (Chap3.Index_Base
                             (Chap3.Get_Array_Base (Ssig), Sig_Type,
                              New_Lit (Ghdl_Index_0)),
                           Get_Element_Subtype (Sig_Type))));
                  Finish_If_Stmt (If_Blk);

                  return New_Obj_Value (Len);
               end;
            when Type_Mode_Record =>
               declare
                  List : Iir_List;
                  El : Iir;
                  Res : O_Enode;
                  E : O_Enode;
                  Sig_El : Mnode;
                  Ssig : Mnode;
               begin
                  List :=
                    Get_Elements_Declaration_List (Get_Base_Type (Sig_Type));
                  Ssig := Stabilize (Sig);
                  Res := O_Enode_Null;
                  for I in Natural loop
                     El := Get_Nth_Element (List, I);
                     exit when El = Null_Iir;
                     Sig_El := Chap6.Translate_Selected_Element (Ssig, El);
                     E := Get_Nbr_Signals (Sig_El, Get_Type (El));
                     if Res /= O_Enode_Null then
                        Res := New_Dyadic_Op (ON_Add_Ov, Res, E);
                     else
                        Res := E;
                     end if;
                  end loop;
                  if Res = O_Enode_Null then
                     --  Empty records.
                     Res := New_Lit (Ghdl_Index_0);
                  end if;
                  return Res;
               end;
            when Type_Mode_Unknown
              | Type_Mode_File
              | Type_Mode_Acc
              | Type_Mode_Fat_Acc
              | Type_Mode_Protected =>
               raise Internal_Error;
         end case;
      end Get_Nbr_Signals;

      --  Get the leftest signal of SIG.
      --  The leftest signal of
      --   a scalar signal is itself,
      --   an array signal is the leftest,
      --   a record signal is the first element.
      function Get_Leftest_Signal (Sig: Mnode; Sig_Type : Iir)
                                  return Mnode
      is
         Res : Mnode;
         Res_Type : Iir;
         Info : Type_Info_Acc;
      begin
         Res := Sig;
         Res_Type := Sig_Type;
         loop
            Info := Get_Type_Info (Res);
            case Info.Type_Mode is
               when Type_Mode_Scalar =>
                  return Res;
               when Type_Mode_Arrays =>
                  Res := Chap3.Index_Base
                    (Chap3.Get_Array_Base (Res), Res_Type,
                     New_Lit (Ghdl_Index_0));
                  Res_Type := Get_Element_Subtype (Res_Type);
               when Type_Mode_Record =>
                  declare
                     Element : Iir;
                  begin
                     Element := Get_First_Element
                       (Get_Elements_Declaration_List
                          (Get_Base_Type (Res_Type)));
                     Res := Chap6.Translate_Selected_Element (Res, Element);
                     Res_Type := Get_Type (Element);
                  end;
               when Type_Mode_Unknown
                 | Type_Mode_File
                 | Type_Mode_Acc
                 | Type_Mode_Fat_Acc
                 | Type_Mode_Protected =>
                  raise Internal_Error;
            end case;
         end loop;
      end Get_Leftest_Signal;

      --  Add func and instance.
      procedure Add_Associations_For_Resolver
        (Assoc : in out O_Assoc_List; Func : Iir)
      is
         Func_Info : Subprg_Info_Acc;
         Resolv_Info : Subprg_Resolv_Info_Acc;
      begin
         Func_Info := Get_Info (Get_Named_Entity (Func));
         Resolv_Info := Func_Info.Subprg_Resolv;
         New_Association
           (Assoc, New_Lit (New_Subprogram_Address (Resolv_Info.Resolv_Func,
                                                    Ghdl_Ptr_Type)));
         if Resolv_Info.Resolv_Block /= Null_Iir then
            New_Association
              (Assoc,
               New_Convert_Ov (Get_Instance_Access (Resolv_Info.Resolv_Block),
                               Ghdl_Ptr_Type));
         else
            New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
         end if;
      end Add_Associations_For_Resolver;

      type O_If_Block_Acc is access O_If_Block;

      type Elab_Signal_Data is record
         --  Default value of the signal.
         Val : Mnode;
         --  If statement for a block of signals.
         If_Stmt : O_If_Block_Acc;
         --  True if the default value is set.
         Has_Val : Boolean;
         --  True if a resolution function was already attached.
         Already_Resolved : Boolean;
         --  True if the signal may already have been created.
         Check_Null : Boolean;
      end record;

      procedure Elab_Signal_Non_Composite (Targ : Mnode;
                                           Targ_Type : Iir;
                                           Data : Elab_Signal_Data)
      is
         Type_Info : Type_Info_Acc;
         Create_Subprg : O_Dnode;
         Conv : O_Tnode;
         Res : O_Enode;
         Assoc : O_Assoc_List;
         Init_Val : O_Enode;
         --  For the resolution function (if any).
         Func : Iir;
         If_Stmt : O_If_Block;
         Targ_Ptr : O_Dnode;
      begin
         Type_Info := Get_Info (Targ_Type);

         if Data.Check_Null then
            Targ_Ptr := Create_Temp_Init
              (Ghdl_Signal_Ptr_Ptr,
               New_Unchecked_Address (M2Lv (Targ), Ghdl_Signal_Ptr_Ptr));
            Start_If_Stmt
              (If_Stmt,
               New_Compare_Op (ON_Eq,
                               New_Value (New_Acc_Value (New_Obj (Targ_Ptr))),
                               New_Lit (New_Null_Access (Ghdl_Signal_Ptr)),
                               Ghdl_Bool_Type));
         end if;

         case Type_Info.Type_Mode is
            when Type_Mode_B2 =>
               Create_Subprg := Ghdl_Create_Signal_B2;
               Conv := Ghdl_Bool_Type;
            when Type_Mode_E8 =>
               Create_Subprg := Ghdl_Create_Signal_E8;
               Conv := Ghdl_I32_Type;
            when Type_Mode_E32 =>
               Create_Subprg := Ghdl_Create_Signal_E32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_I32
              | Type_Mode_P32 =>
               Create_Subprg := Ghdl_Create_Signal_I32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_P64
              | Type_Mode_I64 =>
               Create_Subprg := Ghdl_Create_Signal_I64;
               Conv := Ghdl_I64_Type;
            when Type_Mode_F64 =>
               Create_Subprg := Ghdl_Create_Signal_F64;
               Conv := Ghdl_Real_Type;
            when others =>
               Error_Kind ("elab_signal_non_composite", Targ_Type);
         end case;

         if Data.Has_Val then
            Init_Val := M2E (Data.Val);
         else
            Init_Val := Chap14.Translate_Left_Type_Attribute (Targ_Type);
         end if;

         Start_Association (Assoc, Create_Subprg);
         New_Association (Assoc, New_Convert_Ov (Init_Val, Conv));

         if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then
            Func := Get_Resolution_Function (Targ_Type);
         else
            Func := Null_Iir;
         end if;
         if Func /= Null_Iir and then not Data.Already_Resolved then
            Add_Associations_For_Resolver (Assoc, Func);
         else
            New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
            New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
         end if;

         Res := New_Function_Call (Assoc);

         if Data.Check_Null then
            New_Assign_Stmt (New_Acc_Value (New_Obj (Targ_Ptr)), Res);
            Finish_If_Stmt (If_Stmt);
         else
            New_Assign_Stmt
              (M2Lv (Targ),
               New_Convert_Ov (Res, Type_Info.Ortho_Type (Mode_Signal)));
         end if;
      end Elab_Signal_Non_Composite;

      function Elab_Signal_Prepare_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Elab_Signal_Data)
        return Elab_Signal_Data
      is
         Assoc : O_Assoc_List;
         Func : Iir;
         Res : Elab_Signal_Data;
      begin
         Res := Data;
         if Get_Kind (Targ_Type) in Iir_Kinds_Subtype_Definition then
            Func := Get_Resolution_Function (Targ_Type);
            if Func /= Null_Iir and then not Data.Already_Resolved then
               if Data.Check_Null then
                  Res.If_Stmt := new O_If_Block;
                  Start_If_Stmt
                    (Res.If_Stmt.all,
                     New_Compare_Op
                     (ON_Eq,
                      New_Convert_Ov (M2E (Get_Leftest_Signal (Targ,
                                                               Targ_Type)),
                                      Ghdl_Signal_Ptr),
                      New_Lit (New_Null_Access (Ghdl_Signal_Ptr)),
                      Ghdl_Bool_Type));
                  --Res.Check_Null := False;
               end if;
               --  Add resolver.
               Start_Association (Assoc, Ghdl_Signal_Create_Resolution);
               Add_Associations_For_Resolver (Assoc, Func);
               New_Association
                 (Assoc, New_Convert_Ov (M2Addr (Targ), Ghdl_Ptr_Type));
               New_Association (Assoc, Get_Nbr_Signals (Targ, Targ_Type));
               New_Procedure_Call (Assoc);
               Res.Already_Resolved := True;
            end if;
         end if;
         if Data.Has_Val then
            if Get_Type_Info (Data.Val).Type_Mode = Type_Mode_Record then
               Res.Val := Stabilize (Data.Val);
            else
               Res.Val := Chap3.Get_Array_Base (Data.Val);
            end if;
         end if;
         return Res;
      end Elab_Signal_Prepare_Composite;

      procedure Elab_Signal_Finish_Composite (Data : in out Elab_Signal_Data)
      is
         procedure Free is new Ada.Unchecked_Deallocation
           (Object => O_If_Block, Name => O_If_Block_Acc);
      begin
         if Data.If_Stmt /= null then
            Finish_If_Stmt (Data.If_Stmt.all);
            Free (Data.If_Stmt);
         end if;
      end Elab_Signal_Finish_Composite;

      function Elab_Signal_Update_Array (Data : Elab_Signal_Data;
                                         Targ_Type : Iir;
                                         Index : O_Dnode)
        return Elab_Signal_Data
      is
      begin
         if not Data.Has_Val then
            return Data;
         else
            return Elab_Signal_Data'
              (Val => Chap3.Index_Base (Data.Val, Targ_Type,
                                        New_Obj_Value (Index)),
               Has_Val => True,
               If_Stmt => null,
               Already_Resolved => Data.Already_Resolved,
               Check_Null => Data.Check_Null);
         end if;
      end Elab_Signal_Update_Array;

      function Elab_Signal_Update_Record (Data : Elab_Signal_Data;
                                          Targ_Type : Iir;
                                          El : Iir_Element_Declaration)
        return Elab_Signal_Data
      is
         pragma Unreferenced (Targ_Type);
      begin
         if not Data.Has_Val then
            return Data;
         else
            return Elab_Signal_Data'
              (Val => Chap6.Translate_Selected_Element (Data.Val, El),
               Has_Val => True,
               If_Stmt => null,
               Already_Resolved => Data.Already_Resolved,
               Check_Null => Data.Check_Null);
         end if;
      end Elab_Signal_Update_Record;

      procedure Elab_Signal is new Foreach_Non_Composite
        (Data_Type => Elab_Signal_Data,
         Composite_Data_Type => Elab_Signal_Data,
         Do_Non_Composite => Elab_Signal_Non_Composite,
         Prepare_Data_Array => Elab_Signal_Prepare_Composite,
         Update_Data_Array => Elab_Signal_Update_Array,
         Finish_Data_Array => Elab_Signal_Finish_Composite,
         Prepare_Data_Record => Elab_Signal_Prepare_Composite,
         Update_Data_Record => Elab_Signal_Update_Record,
         Finish_Data_Record => Elab_Signal_Finish_Composite);

      --  Elaborate signal subtypes and allocate the storage for the object.
      procedure Elab_Signal_Declaration_Storage (Decl : Iir)
      is
         Sig_Type : Iir;
         Type_Info : Type_Info_Acc;
         Name_Node : Mnode;
      begin
         New_Debug_Line_Stmt (Get_Line_Number (Decl));

         Open_Temp;

         Sig_Type := Get_Type (Decl);
         Chap3.Elab_Object_Subtype (Sig_Type);
         Type_Info := Get_Info (Sig_Type);

         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
            Name_Node := Chap6.Translate_Name (Decl);
            Name_Node := Stabilize (Name_Node);
            Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type);
         elsif Is_Complex_Type (Type_Info) then
            Name_Node := Chap6.Translate_Name (Decl);
            Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node);
         end if;

         Close_Temp;
      end Elab_Signal_Declaration_Storage;

      function Has_Direct_Driver (Sig : Iir) return Boolean
      is
         Info : Ortho_Info_Acc;
      begin
         Info := Get_Info (Get_Object_Prefix (Sig));
         return Info.Kind = Kind_Object
           and then Info.Object_Driver /= null;
      end Has_Direct_Driver;

      procedure Elab_Direct_Driver_Declaration_Storage (Decl : Iir)
      is
         Sig_Type : Iir;
         Type_Info : Type_Info_Acc;
         Sig_Info : Ortho_Info_Acc;
         Name_Node : Mnode;
      begin
         Open_Temp;

         Sig_Type := Get_Type (Decl);
         Sig_Info := Get_Info (Decl);
         Type_Info := Get_Info (Sig_Type);

         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
            Name_Node := Get_Var (Sig_Info.Object_Driver,
                                  Type_Info, Mode_Value);
            Name_Node := Stabilize (Name_Node);
            --  Copy bounds from signal.
            New_Assign_Stmt
              (M2Lp (Chap3.Get_Array_Bounds (Name_Node)),
               M2Addr (Chap3.Get_Array_Bounds (Chap6.Translate_Name (Decl))));
            --  Allocate base.
            Chap3.Allocate_Fat_Array_Base (Alloc_System, Name_Node, Sig_Type);
         elsif Is_Complex_Type (Type_Info) then
            Name_Node := Get_Var (Sig_Info.Object_Driver,
                                  Type_Info, Mode_Value);
            Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node);
         end if;

         Close_Temp;
      end Elab_Direct_Driver_Declaration_Storage;

      --  Create signal object.
      --  Note: SIG can be a signal sub-element (used when signals are
      --   collapsed).
      --  If CHECK_NULL is TRUE, create the signal only if it was not yet
      --  created.
      procedure Elab_Signal_Declaration_Object
        (Sig : Iir; Parent : Iir; Check_Null : Boolean)
      is
         Decl : constant Iir := Strip_Denoting_Name (Sig);
         Sig_Type : constant Iir := Get_Type (Sig);
         Base_Decl : constant Iir := Get_Object_Prefix (Sig);
         Name_Node : Mnode;
         Val : Iir;
         Data : Elab_Signal_Data;
      begin
         New_Debug_Line_Stmt (Get_Line_Number (Sig));

         Open_Temp;

         --  Set the name of the signal.
         declare
            Assoc : O_Assoc_List;
         begin
            Start_Association (Assoc, Ghdl_Signal_Name_Rti);
            New_Association
              (Assoc,
               New_Lit (New_Global_Unchecked_Address
                        (Get_Info (Base_Decl).Object_Rti,
                         Rtis.Ghdl_Rti_Access)));
            Rtis.Associate_Rti_Context (Assoc, Parent);
            New_Procedure_Call (Assoc);
         end;

         Name_Node := Chap6.Translate_Name (Decl);
         if Get_Object_Kind (Name_Node) /= Mode_Signal then
            raise Internal_Error;
         end if;

         if Decl = Base_Decl then
            Data.Already_Resolved := False;
            Data.Check_Null := Check_Null;
            Val := Get_Default_Value (Base_Decl);
            if Val = Null_Iir then
               Data.Has_Val := False;
            else
               Data.Has_Val := True;
               Data.Val := E2M (Chap7.Translate_Expression (Val, Sig_Type),
                                Get_Info (Sig_Type),
                                Mode_Value);
            end if;
         else
            --  Sub signal.
            --  Do not add resolver.
            --  Do not use default value.
            Data.Already_Resolved := True;
            Data.Has_Val := False;
            Data.Check_Null := False;
         end if;
         Elab_Signal (Name_Node, Sig_Type, Data);

         Close_Temp;
      end Elab_Signal_Declaration_Object;

      procedure Elab_Signal_Declaration
        (Decl : Iir; Parent : Iir; Check_Null : Boolean)
      is
      begin
         Elab_Signal_Declaration_Storage (Decl);
         Elab_Signal_Declaration_Object (Decl, Parent, Check_Null);
      end Elab_Signal_Declaration;

      procedure Elab_Signal_Attribute (Decl : Iir)
      is
         Assoc : O_Assoc_List;
         Dtype : Iir;
         Type_Info : Type_Info_Acc;
         Info : Object_Info_Acc;
         Prefix : Iir;
         Prefix_Node : Mnode;
         Res : O_Enode;
         Val : O_Enode;
         Param : Iir;
         Subprg : O_Dnode;
      begin
         New_Debug_Line_Stmt (Get_Line_Number (Decl));

         Info := Get_Info (Decl);
         Dtype := Get_Type (Decl);
         Type_Info := Get_Info (Dtype);
         --  Create the signal (with the time)
         case Get_Kind (Decl) is
            when Iir_Kind_Stable_Attribute =>
               Subprg := Ghdl_Create_Stable_Signal;
            when Iir_Kind_Quiet_Attribute =>
               Subprg := Ghdl_Create_Quiet_Signal;
            when Iir_Kind_Transaction_Attribute =>
               Subprg := Ghdl_Create_Transaction_Signal;
            when others =>
               Error_Kind ("elab_signal_attribute", Decl);
         end case;
         Start_Association (Assoc, Subprg);
         case Get_Kind (Decl) is
            when Iir_Kind_Stable_Attribute
              | Iir_Kind_Quiet_Attribute =>
               Param := Get_Parameter (Decl);
               if Param = Null_Iir then
                  Val := New_Lit (New_Signed_Literal (Std_Time_Type, 0));
               else
                  Val := Chap7.Translate_Expression (Param);
               end if;
               New_Association (Assoc, Val);
            when others =>
               null;
         end case;
         Res := New_Convert_Ov (New_Function_Call (Assoc),
                                Type_Info.Ortho_Type (Mode_Signal));
         New_Assign_Stmt (Get_Var (Info.Object_Var), Res);

         --  Register all signals this depends on.
         Prefix := Get_Prefix (Decl);
         Prefix_Node := Chap6.Translate_Name (Prefix);
         Register_Signal (Prefix_Node, Get_Type (Prefix),
                          Ghdl_Signal_Attribute_Register_Prefix);
      end Elab_Signal_Attribute;

      type Delayed_Signal_Data is record
         Pfx : Mnode;
         Param : Iir;
      end record;

      procedure Create_Delayed_Signal_Noncomposite
        (Targ : Mnode; Targ_Type : Iir; Data : Delayed_Signal_Data)
      is
         pragma Unreferenced (Targ_Type);
         Assoc : O_Assoc_List;
         Type_Info : Type_Info_Acc;
         Val : O_Enode;
      begin
         Start_Association (Assoc, Ghdl_Create_Delayed_Signal);
         New_Association
           (Assoc,
            New_Convert_Ov (New_Value (M2Lv (Data.Pfx)), Ghdl_Signal_Ptr));
         if Data.Param = Null_Iir then
            Val := New_Lit (New_Signed_Literal (Std_Time_Type, 0));
         else
            Val := Chap7.Translate_Expression (Data.Param);
         end if;
         New_Association (Assoc, Val);
         Type_Info := Get_Type_Info (Targ);
         New_Assign_Stmt
           (M2Lv (Targ),
            New_Convert_Ov (New_Function_Call (Assoc),
                            Type_Info.Ortho_Type (Mode_Signal)));
      end Create_Delayed_Signal_Noncomposite;

      function Create_Delayed_Signal_Prepare_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Delayed_Signal_Data)
        return Delayed_Signal_Data
      is
         pragma Unreferenced (Targ_Type);
         Res : Delayed_Signal_Data;
      begin
         Res.Param := Data.Param;
         if Get_Type_Info (Targ).Type_Mode = Type_Mode_Record then
            Res.Pfx := Stabilize (Data.Pfx);
         else
            Res.Pfx := Chap3.Get_Array_Base (Data.Pfx);
         end if;
         return Res;
      end Create_Delayed_Signal_Prepare_Composite;

      function Create_Delayed_Signal_Update_Data_Array
        (Data : Delayed_Signal_Data; Targ_Type : Iir; Index : O_Dnode)
        return Delayed_Signal_Data
      is
      begin
         return Delayed_Signal_Data'
           (Pfx => Chap3.Index_Base (Data.Pfx, Targ_Type,
                                     New_Obj_Value (Index)),
            Param => Data.Param);
      end Create_Delayed_Signal_Update_Data_Array;

      function Create_Delayed_Signal_Update_Data_Record
        (Data : Delayed_Signal_Data;
         Targ_Type : Iir;
         El : Iir_Element_Declaration)
        return Delayed_Signal_Data
      is
         pragma Unreferenced (Targ_Type);
      begin
         return Delayed_Signal_Data'
           (Pfx => Chap6.Translate_Selected_Element (Data.Pfx, El),
            Param => Data.Param);
      end Create_Delayed_Signal_Update_Data_Record;

      procedure Create_Delayed_Signal_Finish_Data_Composite
        (Data : in out Delayed_Signal_Data)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Create_Delayed_Signal_Finish_Data_Composite;

      procedure Create_Delayed_Signal is new Foreach_Non_Composite
        (Data_Type => Delayed_Signal_Data,
         Composite_Data_Type => Delayed_Signal_Data,
         Do_Non_Composite => Create_Delayed_Signal_Noncomposite,
         Prepare_Data_Array => Create_Delayed_Signal_Prepare_Composite,
         Update_Data_Array => Create_Delayed_Signal_Update_Data_Array,
         Finish_Data_Array => Create_Delayed_Signal_Finish_Data_Composite,
         Prepare_Data_Record => Create_Delayed_Signal_Prepare_Composite,
         Update_Data_Record => Create_Delayed_Signal_Update_Data_Record,
         Finish_Data_Record => Create_Delayed_Signal_Finish_Data_Composite);

      procedure Elab_Signal_Delayed_Attribute (Decl : Iir)
      is
         Name_Node : Mnode;
         Sig_Type : Iir;
         Type_Info : Type_Info_Acc;
         Pfx_Node : Mnode;
         Data: Delayed_Signal_Data;
      begin
         Name_Node := Chap6.Translate_Name (Decl);
         Sig_Type := Get_Type (Decl);
         Type_Info := Get_Info (Sig_Type);

         if Is_Complex_Type (Type_Info) then
            Allocate_Complex_Object (Sig_Type, Alloc_System, Name_Node);
            --  We cannot stabilize NAME_NODE, since Allocate_Complex_Object
            --  assign it.
            Name_Node := Chap6.Translate_Name (Decl);
         end if;

         Pfx_Node := Chap6.Translate_Name (Get_Prefix (Decl));
         Data := Delayed_Signal_Data'(Pfx => Pfx_Node,
                                      Param => Get_Parameter (Decl));

         Create_Delayed_Signal (Name_Node, Get_Type (Decl), Data);
      end Elab_Signal_Delayed_Attribute;

      procedure Elab_File_Declaration (Decl : Iir_File_Declaration)
      is
         Constr : O_Assoc_List;
         Name : Mnode;
         File_Name : Iir;
         Open_Kind : Iir;
         Mode_Val : O_Enode;
         Str : O_Enode;
         Is_Text : Boolean;
         Info : Type_Info_Acc;
      begin
         --  Elaborate the file.
         Name := Chap6.Translate_Name (Decl);
         if Get_Object_Kind (Name) /= Mode_Value then
            raise Internal_Error;
         end if;
         Is_Text := Get_Text_File_Flag (Get_Type (Decl));
         if Is_Text then
            Start_Association (Constr, Ghdl_Text_File_Elaborate);
         else
            Start_Association (Constr, Ghdl_File_Elaborate);
            Info := Get_Info (Get_Type (Decl));
            if Info.T.File_Signature /= O_Dnode_Null then
               New_Association
                 (Constr, New_Address (New_Obj (Info.T.File_Signature),
                                       Char_Ptr_Type));
            else
               New_Association (Constr,
                                New_Lit (New_Null_Access (Char_Ptr_Type)));
            end if;
         end if;
         New_Assign_Stmt (M2Lv (Name), New_Function_Call (Constr));

         --  If file_open_information is present, open the file.
         File_Name := Get_File_Logical_Name (Decl);
         if File_Name = Null_Iir then
            return;
         end if;
         Open_Temp;
         Name := Chap6.Translate_Name (Decl);
         Open_Kind := Get_File_Open_Kind (Decl);
         if Open_Kind /= Null_Iir then
            Mode_Val := New_Convert_Ov
              (Chap7.Translate_Expression (Open_Kind), Ghdl_I32_Type);
         else
            case Get_Mode (Decl) is
               when Iir_In_Mode =>
                  Mode_Val := New_Lit (New_Signed_Literal (Ghdl_I32_Type, 0));
               when Iir_Out_Mode =>
                  Mode_Val := New_Lit (New_Signed_Literal (Ghdl_I32_Type, 1));
               when others =>
                  raise Internal_Error;
            end case;
         end if;
         Str := Chap7.Translate_Expression (File_Name, String_Type_Definition);

         if Is_Text then
            Start_Association (Constr, Ghdl_Text_File_Open);
         else
            Start_Association (Constr, Ghdl_File_Open);
         end if;
         New_Association (Constr, M2E (Name));
         New_Association (Constr, Mode_Val);
         New_Association (Constr, Str);
         New_Procedure_Call (Constr);
         Close_Temp;
      end Elab_File_Declaration;

      procedure Final_File_Declaration (Decl : Iir_File_Declaration)
      is
         Constr : O_Assoc_List;
         Name : Mnode;
         Is_Text : Boolean;
      begin
         Is_Text := Get_Text_File_Flag (Get_Type (Decl));

         Open_Temp;
         Name := Chap6.Translate_Name (Decl);
         Stabilize (Name);

         --  LRM 3.4.1 File Operations
         --  An implicit call to FILE_CLOSE exists in a subprogram body for
         --  every file object declared in the corresponding subprogram
         --  declarative part.  Each such call associates a unique file object
         --  with the formal parameter F and is called whenever the
         --  corresponding subprogram completes its execution.
         if Is_Text then
            Start_Association (Constr, Ghdl_Text_File_Close);
         else
            Start_Association (Constr, Ghdl_File_Close);
         end if;
         New_Association (Constr, M2E (Name));
         New_Procedure_Call (Constr);

         if Is_Text then
            Start_Association (Constr, Ghdl_Text_File_Finalize);
         else
            Start_Association (Constr, Ghdl_File_Finalize);
         end if;
         New_Association (Constr, M2E (Name));
         New_Procedure_Call (Constr);

         Close_Temp;
      end Final_File_Declaration;

      procedure Translate_Type_Declaration (Decl : Iir)
      is
      begin
         Chap3.Translate_Named_Type_Definition (Get_Type_Definition (Decl),
                                                Get_Identifier (Decl));
      end Translate_Type_Declaration;

      procedure Translate_Anonymous_Type_Declaration (Decl : Iir)
      is
         Mark : Id_Mark_Type;
         Mark1 : Id_Mark_Type;
      begin
         Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
         Push_Identifier_Prefix (Mark1, "BT");
         Chap3.Translate_Type_Definition (Get_Type_Definition (Decl));
         Pop_Identifier_Prefix (Mark1);
         Pop_Identifier_Prefix (Mark);
      end Translate_Anonymous_Type_Declaration;

      procedure Translate_Subtype_Declaration (Decl : Iir_Subtype_Declaration)
      is
      begin
         Chap3.Translate_Named_Type_Definition (Get_Type (Decl),
                                                Get_Identifier (Decl));
      end Translate_Subtype_Declaration;

      procedure Translate_Bool_Type_Declaration (Decl : Iir_Type_Declaration)
      is
         Mark : Id_Mark_Type;
      begin
         Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
         Chap3.Translate_Bool_Type_Definition (Get_Type_Definition (Decl));
         Pop_Identifier_Prefix (Mark);
      end Translate_Bool_Type_Declaration;

      procedure Translate_Object_Alias_Declaration
        (Decl : Iir_Object_Alias_Declaration)
      is
         Decl_Type : Iir;
         Info : Alias_Info_Acc;
         Tinfo : Type_Info_Acc;
         Atype : O_Tnode;
      begin
         Decl_Type := Get_Type (Decl);

         Chap3.Translate_Named_Type_Definition
           (Decl_Type, Get_Identifier (Decl));

         Info := Add_Info (Decl, Kind_Alias);
         case Get_Kind (Get_Object_Prefix (Decl)) is
            when Iir_Kind_Signal_Declaration
              | Iir_Kind_Signal_Interface_Declaration
              | Iir_Kind_Guard_Signal_Declaration =>
               Info.Alias_Kind := Mode_Signal;
            when others =>
               Info.Alias_Kind := Mode_Value;
         end case;

         Tinfo := Get_Info (Decl_Type);
         case Tinfo.Type_Mode is
            when Type_Mode_Fat_Array =>
               --  create an object.
               --  At elaboration: copy base from name, copy bounds from type,
               --   check for matching bounds.
               Atype := Get_Ortho_Type (Decl_Type, Info.Alias_Kind);
            when Type_Mode_Array
              | Type_Mode_Acc
              | Type_Mode_Fat_Acc =>
               --  Create an object pointer.
               --  At elaboration: copy base from name.
               Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind);
            when Type_Mode_Scalar =>
               case Info.Alias_Kind is
                  when Mode_Signal =>
                     Atype := Tinfo.Ortho_Type (Mode_Signal);
                  when Mode_Value =>
                     Atype := Tinfo.Ortho_Ptr_Type (Mode_Value);
               end case;
            when Type_Mode_Record =>
               --  Create an object pointer.
               --  At elaboration: copy base from name.
               Atype := Tinfo.Ortho_Ptr_Type (Info.Alias_Kind);
            when others =>
               raise Internal_Error;
         end case;
         Info.Alias_Var := Create_Var (Create_Var_Identifier (Decl), Atype);
      end Translate_Object_Alias_Declaration;

      procedure Elab_Object_Alias_Declaration
        (Decl : Iir_Object_Alias_Declaration)
      is
         Decl_Type : Iir;
         Name : Iir;
         Name_Node : Mnode;
         Alias_Node : Mnode;
         Alias_Info : Alias_Info_Acc;
         Name_Type : Iir;
         Tinfo : Type_Info_Acc;
         Kind : Object_Kind_Type;
      begin
         New_Debug_Line_Stmt (Get_Line_Number (Decl));

         Decl_Type := Get_Type (Decl);
         Tinfo := Get_Info (Decl_Type);

         Alias_Info := Get_Info (Decl);
         Chap3.Elab_Object_Subtype (Decl_Type);
         Name := Get_Name (Decl);
         Name_Type := Get_Type (Name);
         Name_Node := Chap6.Translate_Name (Name);
         Kind := Get_Object_Kind (Name_Node);

         case Tinfo.Type_Mode is
            when Type_Mode_Fat_Array =>
               Open_Temp;
               Stabilize (Name_Node);
               Alias_Node := Stabilize
                 (Get_Var (Alias_Info.Alias_Var,
                           Tinfo, Alias_Info.Alias_Kind));
               Copy_Fat_Pointer (Alias_Node, Name_Node);
               Close_Temp;
            when Type_Mode_Array =>
               Open_Temp;
               Stabilize (Name_Node);
               New_Assign_Stmt
                 (Get_Var (Alias_Info.Alias_Var),
                  M2E (Chap3.Get_Array_Base (Name_Node)));
               Chap3.Check_Array_Match (Decl_Type, T2M (Decl_Type, Kind),
                                        Name_Type, Name_Node,
                                        Decl);
               Close_Temp;
            when Type_Mode_Acc
              | Type_Mode_Fat_Acc =>
               New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var),
                                M2Addr (Name_Node));
            when Type_Mode_Scalar =>
               case Alias_Info.Alias_Kind is
                  when Mode_Value =>
                     New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var),
                                      M2Addr (Name_Node));
                  when Mode_Signal =>
                     New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var),
                                      M2E (Name_Node));
               end case;
            when Type_Mode_Record =>
               Open_Temp;
               Stabilize (Name_Node);
               New_Assign_Stmt (Get_Var (Alias_Info.Alias_Var),
                                M2Addr (Name_Node));
               Close_Temp;
            when others =>
               raise Internal_Error;
         end case;
      end Elab_Object_Alias_Declaration;

      procedure Translate_Port_Chain (Parent : Iir)
      is
         Port : Iir;
      begin
         Port := Get_Port_Chain (Parent);
         while Port /= Null_Iir loop
            Create_Signal (Port);
            Port := Get_Chain (Port);
         end loop;
      end Translate_Port_Chain;

      procedure Translate_Generic_Chain (Parent : Iir)
      is
         Decl : Iir;
      begin
         Decl := Get_Generic_Chain (Parent);
         while Decl /= Null_Iir loop
            Create_Object (Decl);
            Decl := Get_Chain (Decl);
         end loop;
      end Translate_Generic_Chain;

      --  Create instance record for a component.
      procedure Translate_Component_Declaration (Decl : Iir)
      is
         Mark : Id_Mark_Type;
         Info : Ortho_Info_Acc;
      begin
         Info := Add_Info (Decl, Kind_Component);
         Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
         Push_Instance_Factory (O_Tnode_Null);

         Info.Comp_Link := Add_Instance_Factory_Field
           (Wki_Instance, Rtis.Ghdl_Component_Link_Type);

         --  Generic and ports.
         Translate_Generic_Chain (Decl);
         Translate_Port_Chain (Decl);

         Pop_Instance_Factory (Info.Comp_Type);
         New_Type_Decl (Create_Identifier ("_COMPTYPE"), Info.Comp_Type);
         Info.Comp_Ptr_Type := New_Access_Type (Info.Comp_Type);
         New_Type_Decl (Create_Identifier ("_COMPPTR"), Info.Comp_Ptr_Type);
         Pop_Identifier_Prefix (Mark);
      end Translate_Component_Declaration;

      procedure Translate_Declaration (Decl : Iir)
      is
      begin
         case Get_Kind (Decl) is
            when Iir_Kind_Use_Clause =>
               null;
            when Iir_Kind_Configuration_Specification =>
               null;
            when Iir_Kind_Disconnection_Specification =>
               null;

            when Iir_Kind_Component_Declaration =>
               Chap4.Translate_Component_Declaration (Decl);
            when Iir_Kind_Type_Declaration =>
               Chap4.Translate_Type_Declaration (Decl);
            when Iir_Kind_Anonymous_Type_Declaration =>
               Chap4.Translate_Anonymous_Type_Declaration (Decl);
            when Iir_Kind_Subtype_Declaration =>
               Chap4.Translate_Subtype_Declaration (Decl);

            when Iir_Kind_Function_Declaration
              | Iir_Kind_Procedure_Declaration =>
               raise Internal_Error;
            when Iir_Kind_Function_Body
              | Iir_Kind_Procedure_Body =>
               null;

            when Iir_Kind_Protected_Type_Body =>
               null;

            --when Iir_Kind_Implicit_Function_Declaration =>
            --when Iir_Kind_Signal_Declaration
            --  | Iir_Kind_Signal_Interface_Declaration =>
               --   Chap4.Create_Object (Decl);

            when Iir_Kind_Variable_Declaration
              | Iir_Kind_Constant_Declaration =>
               Create_Object (Decl);

            when Iir_Kind_Signal_Declaration =>
               Create_Signal (Decl);

            when Iir_Kind_Object_Alias_Declaration =>
               Translate_Object_Alias_Declaration (Decl);

            when Iir_Kind_Non_Object_Alias_Declaration =>
               null;

            when Iir_Kind_File_Declaration =>
               Create_File_Object (Decl);

            when Iir_Kind_Attribute_Declaration =>
               Chap3.Translate_Object_Subtype (Decl);

            when Iir_Kind_Attribute_Specification =>
               Chap5.Translate_Attribute_Specification (Decl);

            when Iir_Kinds_Signal_Attribute =>
               Chap4.Create_Implicit_Signal (Decl);

            when Iir_Kind_Guard_Signal_Declaration =>
               Create_Signal (Decl);

            when Iir_Kind_Group_Template_Declaration =>
               null;
            when Iir_Kind_Group_Declaration =>
               null;

            when others =>
               Error_Kind ("translate_declaration", Decl);
         end case;
      end Translate_Declaration;

      procedure Translate_Resolution_Function (Func : Iir; Block : Iir)
      is
         --  Type of the resolution function parameter.
         El_Type : Iir;
         El_Info : Type_Info_Acc;
         Finfo : constant Subprg_Info_Acc := Get_Info (Func);
         Interface_List : O_Inter_List;
         Rinfo : constant Subprg_Resolv_Info_Acc := Finfo.Subprg_Resolv;
         Block_Info : Block_Info_Acc;
         Id : O_Ident;
         Itype : O_Tnode;
      begin
         if Rinfo = null then
            --  Not a resolution function
            return;
         end if;

         --  Declare the procedure.
         Id := Create_Identifier (Func, Get_Overload_Number (Func), "_RESOLV");
         Start_Procedure_Decl (Interface_List, Id, Global_Storage);

         --  The instance.
         if Block /= Null_Iir then
            Block_Info := Get_Info (Block);
            Rinfo.Resolv_Block := Block;
            Itype := Block_Info.Block_Decls_Ptr_Type;
         else
            --  Create a dummy instance parameter
            Rinfo.Resolv_Block := Null_Iir;
            Itype := Ghdl_Ptr_Type;
         end if;
         New_Interface_Decl
           (Interface_List, Rinfo.Var_Instance, Wki_Instance, Itype);

         --  The signal.
         El_Type := Get_Type (Get_Interface_Declaration_Chain (Func));
         El_Type := Get_Element_Subtype (El_Type);
         El_Info := Get_Info (El_Type);
         --  FIXME: create a function for getting the type of an interface.
         case El_Info.Type_Mode is
            when Type_Mode_Thin =>
               Itype := El_Info.Ortho_Type (Mode_Signal);
            when Type_Mode_Fat =>
               Itype := El_Info.Ortho_Ptr_Type (Mode_Signal);
            when Type_Mode_Unknown =>
               raise Internal_Error;
         end case;
         New_Interface_Decl
           (Interface_List, Rinfo.Var_Vals, Get_Identifier ("VALS"), Itype);

         New_Interface_Decl
           (Interface_List, Rinfo.Var_Vec, Get_Identifier ("bool_vec"),
            Ghdl_Bool_Array_Ptr);
         New_Interface_Decl
           (Interface_List, Rinfo.Var_Vlen, Get_Identifier ("vec_len"),
            Ghdl_Index_Type);
         New_Interface_Decl
           (Interface_List, Rinfo.Var_Nbr_Drv, Get_Identifier ("nbr_drv"),
            Ghdl_Index_Type);
         New_Interface_Decl
           (Interface_List, Rinfo.Var_Nbr_Ports, Get_Identifier ("nbr_ports"),
            Ghdl_Index_Type);

         Finish_Subprogram_Decl (Interface_List, Rinfo.Resolv_Func);
      end Translate_Resolution_Function;

      type Read_Source_Kind is (Read_Port, Read_Driver);
      type Read_Source_Data is record
         Sig : Mnode;
         Drv_Index : O_Dnode;
         Kind : Read_Source_Kind;
      end record;

      procedure Read_Source_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Read_Source_Data)
      is
         Assoc : O_Assoc_List;
         Targ_Info : Type_Info_Acc;
         E : O_Enode;
      begin
         Targ_Info := Get_Info (Targ_Type);
         case Data.Kind is
            when Read_Port =>
               Start_Association (Assoc, Ghdl_Signal_Read_Port);
            when Read_Driver =>
               Start_Association (Assoc, Ghdl_Signal_Read_Driver);
         end case;

         New_Association
           (Assoc, New_Convert_Ov (M2E (Data.Sig), Ghdl_Signal_Ptr));
         New_Association (Assoc, New_Obj_Value (Data.Drv_Index));
         E := New_Convert_Ov (New_Function_Call (Assoc),
                              Targ_Info.Ortho_Ptr_Type (Mode_Value));
         New_Assign_Stmt (M2Lv (Targ),
                          New_Value (New_Access_Element (E)));
      end Read_Source_Non_Composite;

      function Read_Source_Prepare_Data_Array
        (Targ: Mnode; Targ_Type : Iir; Data : Read_Source_Data)
        return Read_Source_Data
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Data;
      end Read_Source_Prepare_Data_Array;

      function Read_Source_Prepare_Data_Record
        (Targ : Mnode; Targ_Type : Iir; Data : Read_Source_Data)
        return Read_Source_Data
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Read_Source_Data'(Sig => Stabilize (Data.Sig),
                                  Drv_Index => Data.Drv_Index,
                                  Kind => Data.Kind);
      end Read_Source_Prepare_Data_Record;

      function Read_Source_Update_Data_Array
        (Data : Read_Source_Data; Targ_Type : Iir; Index : O_Dnode)
        return Read_Source_Data
      is
      begin
         return Read_Source_Data'
           (Sig => Chap3.Index_Base (Data.Sig, Targ_Type,
                                     New_Obj_Value (Index)),
            Drv_Index => Data.Drv_Index,
            Kind => Data.Kind);
      end Read_Source_Update_Data_Array;

      function Read_Source_Update_Data_Record
        (Data : Read_Source_Data;
         Targ_Type : Iir;
         El : Iir_Element_Declaration)
        return Read_Source_Data
      is
         pragma Unreferenced (Targ_Type);
      begin
         return Read_Source_Data'
           (Sig => Chap6.Translate_Selected_Element (Data.Sig, El),
            Drv_Index => Data.Drv_Index,
            Kind => Data.Kind);
      end Read_Source_Update_Data_Record;

      procedure Read_Source_Finish_Data_Composite
        (Data : in out Read_Source_Data)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Read_Source_Finish_Data_Composite;

      procedure Read_Signal_Source is new Foreach_Non_Composite
        (Data_Type => Read_Source_Data,
         Composite_Data_Type => Read_Source_Data,
         Do_Non_Composite => Read_Source_Non_Composite,
         Prepare_Data_Array => Read_Source_Prepare_Data_Array,
         Update_Data_Array => Read_Source_Update_Data_Array,
         Finish_Data_Array => Read_Source_Finish_Data_Composite,
         Prepare_Data_Record => Read_Source_Prepare_Data_Record,
         Update_Data_Record => Read_Source_Update_Data_Record,
         Finish_Data_Record => Read_Source_Finish_Data_Composite);

      procedure Translate_Resolution_Function_Body (Func : Iir; Block : Iir)
      is
         --  Type of the resolution function parameter.
         Arr_Type : Iir;
         Base_Type : Iir;
         Base_Info : Type_Info_Acc;

         --  Type of parameter element.
         El_Type : Iir;
         El_Info : Type_Info_Acc;

         --  Type of the function return value.
         Ret_Type : Iir;
         Ret_Info : Type_Info_Acc;

         --  Type and info of the array index.
         Index_Type : Iir;
         Index_Tinfo : Type_Info_Acc;

         --  Local variables.
         Var_I : O_Dnode;
         Var_J : O_Dnode;
         Var_Length : O_Dnode;
         Var_Res : O_Dnode;

         Vals : Mnode;
         Res : Mnode;

         If_Blk : O_If_Block;
         Label : O_Snode;

         V : Mnode;

         Var_Bound : O_Dnode;
         Var_Range_Ptr : O_Dnode;
         Var_Array : O_Dnode;
         Finfo : constant Subprg_Info_Acc := Get_Info (Func);
         Rinfo : constant Subprg_Resolv_Info_Acc := Finfo.Subprg_Resolv;
         Assoc : O_Assoc_List;
         Block_Info : Block_Info_Acc;

         Data : Read_Source_Data;
      begin
         if Rinfo = null then
            --  Not resolver for this function
            return;
         end if;

         Ret_Type := Get_Return_Type (Func);
         Ret_Info := Get_Info (Ret_Type);

         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Func));
         Base_Type := Get_Base_Type (Arr_Type);
         Base_Info := Get_Info (Base_Type);

         El_Type := Get_Element_Subtype (Arr_Type);
         El_Info := Get_Info (El_Type);

         Index_Type := Get_Index_Type (Arr_Type, 0);
         Index_Tinfo := Get_Info (Index_Type);

         Start_Subprogram_Body (Rinfo.Resolv_Func);
         if Rinfo.Resolv_Block /= Null_Iir then
            Block_Info := Get_Info (Block);
            Push_Scope (Block_Info.Block_Decls_Type, Rinfo.Var_Instance);
         end if;
         Push_Local_Factory;

         --  A signal.

         New_Var_Decl
           (Var_Res, Get_Identifier ("res"),
            O_Storage_Local, Get_Object_Type (Ret_Info, Mode_Value));

         --  I, J.
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         New_Var_Decl (Var_J, Get_Identifier ("J"),
                       O_Storage_Local, Ghdl_Index_Type);

         --  Length.
         New_Var_Decl
           (Var_Length, Wki_Length, O_Storage_Local, Ghdl_Index_Type);

         New_Var_Decl (Var_Bound, Get_Identifier ("BOUND"), O_Storage_Local,
                       Base_Info.T.Bounds_Type);
         New_Var_Decl (Var_Array, Get_Identifier ("ARRAY"), O_Storage_Local,
                       Base_Info.Ortho_Type (Mode_Value));

         New_Var_Decl (Var_Range_Ptr, Get_Identifier ("RANGE_PTR"),
                       O_Storage_Local, Index_Tinfo.T.Range_Ptr_Type);

         Open_Temp;

         case El_Info.Type_Mode is
            when Type_Mode_Thin =>
               Vals := Dv2M (Rinfo.Var_Vals, El_Info, Mode_Signal);
            when Type_Mode_Fat =>
               Vals := Dp2M (Rinfo.Var_Vals, El_Info, Mode_Signal);
            when Type_Mode_Unknown =>
               raise Internal_Error;
         end case;

         -- * length := vec_len + nports;
         New_Assign_Stmt (New_Obj (Var_Length),
                          New_Dyadic_Op (ON_Add_Ov,
                                         New_Obj_Value (Rinfo.Var_Vlen),
                                         New_Obj_Value (Rinfo.Var_Nbr_Ports)));

         -- * range_ptr := BOUND.dim_1'address;
         New_Assign_Stmt
           (New_Obj (Var_Range_Ptr),
            New_Address (New_Selected_Element (New_Obj (Var_Bound),
                                               Base_Info.T.Bounds_Vector (1)),
                         Index_Tinfo.T.Range_Ptr_Type));

         --  Create range from length
         Chap3.Create_Range_From_Length
           (Index_Type, Var_Length, Var_Range_Ptr, Func);
         New_Assign_Stmt
           (New_Selected_Element (New_Obj (Var_Array),
                                  Base_Info.T.Bounds_Field (Mode_Value)),
            New_Address (New_Obj (Var_Bound), Base_Info.T.Bounds_Ptr_Type));

         --  Allocate the array.
         Chap3.Allocate_Fat_Array_Base
           (Alloc_Stack, Dv2M (Var_Array, Base_Info, Mode_Value), Base_Type);

         --  Fill the array
         --  1. From ports.
         --  * I := 0;
         Init_Var (Var_I);
         --  * loop
         Start_Loop_Stmt (Label);
         --  *   exit when I = nports;
         Gen_Exit_When (Label,
                        New_Compare_Op (ON_Eq,
                                        New_Obj_Value (Var_I),
                                        New_Obj_Value (Rinfo.Var_Nbr_Ports),
                                        Ghdl_Bool_Type));
         --      fill array[i]
         V := Chap3.Index_Base
           (Chap3.Get_Array_Base (Dv2M (Var_Array, Base_Info, Mode_Value)),
            Base_Type, New_Obj_Value (Var_I));
         Data := Read_Source_Data'(Vals, Var_I, Read_Port);
         Read_Signal_Source (V, El_Type, Data);

         --  *   I := I + 1;
         Inc_Var (Var_I);
         --  * end loop;
         Finish_Loop_Stmt (Label);

         --  2. From drivers.
         --  * J := 0;
         --  * loop
         --  *   exit when j = var_max;
         --  *   if vec[j] then
         --
         --  *     ptr := get_signal_driver (sig, j);
         --  *     array[i].XXX := *ptr
         --
         --  *     i := i + 1;
         --  *   end if;
         --  *   J := J + 1;
         --  * end loop;
         Init_Var (Var_J);
         Start_Loop_Stmt (Label);
         Gen_Exit_When (Label,
                        New_Compare_Op (ON_Eq,
                                        New_Obj_Value (Var_J),
                                        New_Obj_Value (Rinfo.Var_Nbr_Drv),
                                        Ghdl_Bool_Type));
         Start_If_Stmt
           (If_Blk,
            New_Value (New_Indexed_Acc_Value (New_Obj (Rinfo.Var_Vec),
                                              New_Obj_Value (Var_J))));

         V := Chap3.Index_Base
           (Chap3.Get_Array_Base (Dv2M (Var_Array, Base_Info, Mode_Value)),
            Base_Type, New_Obj_Value (Var_I));
         Data := Read_Source_Data'(Vals, Var_J, Read_Driver);
         Read_Signal_Source (V, El_Type, Data);

         Inc_Var (Var_I);
         Finish_If_Stmt (If_Blk);

         Inc_Var (Var_J);
         Finish_Loop_Stmt (Label);

         if Finfo.Res_Interface /= O_Dnode_Null then
            Res := Lo2M (Var_Res, Ret_Info, Mode_Value);
            if Ret_Info.Type_Mode /= Type_Mode_Fat_Array then
               Allocate_Complex_Object (Ret_Type, Alloc_Stack, Res);
            end if;
         end if;

         --  Call the resolution function.
         Start_Association (Assoc, Finfo.Ortho_Func);
         if Finfo.Res_Interface /= O_Dnode_Null then
            New_Association (Assoc, M2E (Res));
         end if;
         Chap2.Add_Subprg_Instance_Assoc (Assoc, Finfo.Subprg_Instance);
         New_Association
           (Assoc, New_Address (New_Obj (Var_Array),
                                Base_Info.Ortho_Ptr_Type (Mode_Value)));

         if Finfo.Res_Interface = O_Dnode_Null then
            Res := E2M (New_Function_Call (Assoc), Ret_Info, Mode_Value);
         else
            New_Procedure_Call (Assoc);
         end if;

         if El_Type /= Ret_Type then
            Res := E2M
              (Chap7.Translate_Implicit_Conv (M2E (Res), Ret_Type, El_Type,
                                              Mode_Value, Func),
               El_Info, Mode_Value);
         end if;
         Chap7.Set_Driving_Value (Vals, El_Type, Res);

         Close_Temp;
         Pop_Local_Factory;
         if Rinfo.Resolv_Block /= Null_Iir then
            Pop_Scope (Block_Info.Block_Decls_Type);
         end if;
         Finish_Subprogram_Body;
      end Translate_Resolution_Function_Body;

      procedure Translate_Declaration_Chain (Parent : Iir)
      is
         Info : Subprg_Info_Acc;
         El : Iir;
      begin
         El := Get_Declaration_Chain (Parent);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Procedure_Declaration
                 | Iir_Kind_Function_Declaration =>
                  --  Translate interfaces.
                  if (not Flag_Discard_Unused or else Get_Use_Flag (El))
                    and then not Is_Second_Subprogram_Specification (El)
                  then
                     Info := Add_Info (El, Kind_Subprg);
                     Chap2.Translate_Subprogram_Interfaces (El);
                     if Get_Kind (El) = Iir_Kind_Function_Declaration then
                        if Get_Resolution_Function_Flag (El) then
                           Info.Subprg_Resolv := new Subprg_Resolv_Info;
                        end if;
                     end if;
                  end if;
               when Iir_Kind_Function_Body
                 | Iir_Kind_Procedure_Body =>
                  null;
               when Iir_Kind_Implicit_Function_Declaration
                 | Iir_Kind_Implicit_Procedure_Declaration =>
                  null;
               when others =>
                  Translate_Declaration (El);
            end case;
            El := Get_Chain (El);
         end loop;
      end Translate_Declaration_Chain;

      procedure Translate_Declaration_Chain_Subprograms
        (Parent : Iir; Block : Iir)
      is
         El : Iir;
         Infos  : Chap7.Implicit_Subprogram_Infos;
      begin
         El := Get_Declaration_Chain (Parent);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Procedure_Declaration
                 | Iir_Kind_Function_Declaration =>
                  --  Translate only if used.
                  if Get_Info (El) /= null then
                     Chap2.Translate_Subprogram_Declaration (El);
                     Translate_Resolution_Function (El, Block);
                  end if;
               when Iir_Kind_Function_Body
                 | Iir_Kind_Procedure_Body =>
                  --  Do not translate body if generating only specs (for
                  --  subprograms in an entity).
                  if Global_Storage /= O_Storage_External
                    and then
                    (not Flag_Discard_Unused
                       or else
                       Get_Use_Flag (Get_Subprogram_Specification (El)))
                  then
                     Chap2.Translate_Subprogram_Body (El);
                     Translate_Resolution_Function_Body
                       (Get_Subprogram_Specification (El), Block);
                  end if;
               when Iir_Kind_Type_Declaration
                 | Iir_Kind_Anonymous_Type_Declaration =>
                  Chap3.Translate_Type_Subprograms (El);
                  Chap7.Init_Implicit_Subprogram_Infos (Infos);
               when Iir_Kind_Protected_Type_Body =>
                  Chap3.Translate_Protected_Type_Body (El);
                  Chap3.Translate_Protected_Type_Body_Subprograms (El);
               when Iir_Kind_Implicit_Function_Declaration
                 | Iir_Kind_Implicit_Procedure_Declaration =>
                  if Flag_Discard_Unused_Implicit
                    and then not Get_Use_Flag (El)
                  then
                     case Get_Implicit_Definition (El) is
                        when Iir_Predefined_Array_Equality
                          | Iir_Predefined_Array_Greater
                          | Iir_Predefined_Record_Equality =>
                           --  Used implicitly in case statement or other
                           --  predefined equality.
                           Chap7.Translate_Implicit_Subprogram (El, Infos);
                        when others =>
                           null;
                     end case;
                  else
                     Chap7.Translate_Implicit_Subprogram (El, Infos);
                  end if;
               when others =>
                  null;
            end case;
            El := Get_Chain (El);
         end loop;
      end Translate_Declaration_Chain_Subprograms;

      procedure Elab_Declaration_Chain (Parent : Iir; Need_Final : out Boolean)
      is
         Decl : Iir;
      begin
         Decl := Get_Declaration_Chain (Parent);
         Need_Final := False;
         while Decl /= Null_Iir loop
            case Get_Kind (Decl) is
               when Iir_Kind_Use_Clause =>
                  null;
               when Iir_Kind_Component_Declaration =>
                  null;
               when Iir_Kind_Configuration_Specification =>
                  null;
               when Iir_Kind_Disconnection_Specification =>
                  Chap5.Elab_Disconnection_Specification (Decl);

               when Iir_Kind_Type_Declaration
                 | Iir_Kind_Anonymous_Type_Declaration =>
                  Chap3.Elab_Type_Declaration (Decl);
               when Iir_Kind_Subtype_Declaration =>
                  Chap3.Elab_Subtype_Declaration (Decl);

               when Iir_Kind_Protected_Type_Body =>
                  null;

               --when Iir_Kind_Signal_Declaration =>
               --   Chap1.Elab_Signal (Decl);
               when Iir_Kind_Variable_Declaration
                 | Iir_Kind_Constant_Declaration =>
                  Elab_Object (Decl);
                  if Get_Kind (Get_Type (Decl))
                    = Iir_Kind_Protected_Type_Declaration
                  then
                     Need_Final := True;
                  end if;

               when Iir_Kind_Signal_Declaration =>
                  Elab_Signal_Declaration (Decl, Parent, False);

               when Iir_Kind_Object_Alias_Declaration =>
                  Elab_Object_Alias_Declaration (Decl);

               when Iir_Kind_Non_Object_Alias_Declaration =>
                  null;

               when Iir_Kind_File_Declaration =>
                  Elab_File_Declaration (Decl);
                  Need_Final := True;

               when Iir_Kind_Attribute_Declaration =>
                  Chap3.Elab_Object_Subtype (Get_Type (Decl));

               when Iir_Kind_Attribute_Specification =>
                  Chap5.Elab_Attribute_Specification (Decl);

               when Iir_Kind_Function_Declaration
                 | Iir_Kind_Procedure_Declaration =>
                  if Get_Info (Decl) /= null then
                     Chap2.Elab_Subprogram_Interfaces (Decl);
                  end if;
               when Iir_Kind_Function_Body
                 | Iir_Kind_Procedure_Body =>
                  null;

               when Iir_Kind_Implicit_Function_Declaration
                 | Iir_Kind_Implicit_Procedure_Declaration =>
                  null;

               when Iir_Kind_Stable_Attribute
                 | Iir_Kind_Quiet_Attribute
                 | Iir_Kind_Transaction_Attribute =>
                  Elab_Signal_Attribute (Decl);

               when Iir_Kind_Delayed_Attribute =>
                  Elab_Signal_Delayed_Attribute (Decl);

               when Iir_Kind_Group_Template_Declaration
                 | Iir_Kind_Group_Declaration =>
                  null;

               when others =>
                  Error_Kind ("elab_declaration_chain", Decl);
            end case;

            Decl := Get_Chain (Decl);
         end loop;
      end Elab_Declaration_Chain;

      procedure Final_Declaration_Chain (Parent : Iir; Deallocate : Boolean)
      is
         Decl : Iir;
      begin
         Decl := Get_Declaration_Chain (Parent);
         while Decl /= Null_Iir loop
            case Get_Kind (Decl) is
               when Iir_Kind_File_Declaration =>
                  Final_File_Declaration (Decl);
               when Iir_Kind_Variable_Declaration =>
                  if Get_Kind (Get_Type (Decl))
                    = Iir_Kind_Protected_Type_Declaration
                  then
                     Fini_Protected_Object (Decl);
                  end if;
                  if Deallocate then
                     Fini_Object (Decl);
                  end if;
               when Iir_Kind_Constant_Declaration =>
                  if Deallocate then
                     Fini_Object (Decl);
                  end if;
               when others =>
                  null;
            end case;

            Decl := Get_Chain (Decl);
         end loop;
      end Final_Declaration_Chain;

      type Conv_Mode is (Conv_Mode_In, Conv_Mode_Out);

      --  Create subprogram for an association conversion.
      --  STMT is the statement/block_header containing the association.
      --  BLOCK is the architecture/block containing the instance.
      --  ASSOC is the association and MODE the conversion to work on.
      --  CONV_INFO is the result place holder.
      --  BASE_BLOCK is the base architecture/block containing the instance.
      --  ENTITY is the entity/component instantiated (null for block_stmt)
      procedure Translate_Association_Subprogram
        (Stmt : Iir;
         Block : Iir;
         Assoc : Iir;
         Mode : Conv_Mode;
         Conv_Info : in out Assoc_Conv_Info;
         Base_Block : Iir;
         Entity : Iir)
      is
         Formal : constant Iir := Get_Formal (Assoc);
         Actual : constant Iir := Get_Actual (Assoc);

         Mark2, Mark3 : Id_Mark_Type;
         Inter_List : O_Inter_List;
         In_Type, Out_Type : Iir;
         In_Info, Out_Info : Type_Info_Acc;
         Itype : O_Tnode;
         El_List : O_Element_List;
         Block_Info : Block_Info_Acc;
         Stmt_Info : Block_Info_Acc;
         Entity_Info : Ortho_Info_Acc;
         Var_Data : O_Dnode;

         --  Variables for body.
         E : O_Enode;
         V : O_Dnode;
         V1 : O_Lnode;
         V_Out : Mnode;
         R : O_Enode;
         Constr : O_Assoc_List;
         Subprg_Info : Subprg_Info_Acc;
         Res : Mnode;
         Imp : Iir;
         Func : Iir;
      begin
         case Mode is
            when Conv_Mode_In =>
               --  IN: from actual to formal.
               Push_Identifier_Prefix (Mark2, "CONVIN");
               Out_Type := Get_Type (Formal);
               In_Type := Get_Type (Actual);
               Imp := Get_In_Conversion (Assoc);

            when Conv_Mode_Out =>
               --  OUT: from formal to actual.
               Push_Identifier_Prefix (Mark2, "CONVOUT");
               In_Type := Get_Type (Formal);
               Out_Type := Get_Type (Actual);
               Imp := Get_Out_Conversion (Assoc);

         end case;
         --  FIXME: individual assoc -> overload.
         Push_Identifier_Prefix
           (Mark3, Get_Identifier (Get_Association_Interface (Assoc)));

         --  Handle anonymous subtypes.
         Chap3.Translate_Anonymous_Type_Definition (Out_Type, False);
         Chap3.Translate_Anonymous_Type_Definition (In_Type, False);
         Out_Info := Get_Info (Out_Type);
         In_Info := Get_Info (In_Type);

         --  Start record containing data for the conversion function.
         Start_Record_Type (El_List);

         --  Add instance field.
         Conv_Info.Instance_Block := Base_Block;
         Block_Info := Get_Info (Base_Block);
         New_Record_Field
           (El_List, Conv_Info.Instance_Field, Wki_Instance,
            Block_Info.Block_Decls_Ptr_Type);

         if Entity /= Null_Iir then
            Conv_Info.Instantiated_Entity := Entity;
            Entity_Info := Get_Info (Entity);
            declare
               Ptr : O_Tnode;
            begin
               if Entity_Info.Kind = Kind_Component then
                  Ptr := Entity_Info.Comp_Ptr_Type;
               else
                  Ptr := Entity_Info.Block_Decls_Ptr_Type;
               end if;
               New_Record_Field
                 (El_List, Conv_Info.Instantiated_Field,
                  Get_Identifier ("instantiated"), Ptr);
            end;
         else
            Conv_Info.Instantiated_Entity := Null_Iir;
            Conv_Info.Instantiated_Field := O_Fnode_Null;
         end if;

         --  Add input.
         case In_Info.Type_Mode is
            when Type_Mode_Thin =>
               Itype := In_Info.Ortho_Type (Mode_Signal);
            when Type_Mode_Fat =>
               Itype := In_Info.Ortho_Ptr_Type (Mode_Signal);
            when Type_Mode_Unknown =>
               raise Internal_Error;
         end case;
         New_Record_Field
           (El_List, Conv_Info.In_Field, Get_Identifier ("val_in"), Itype);

         --  Add output.
         New_Record_Field
           (El_List, Conv_Info.Out_Field, Get_Identifier ("val_out"),
            Get_Object_Type (Out_Info, Mode_Signal));
         Finish_Record_Type (El_List, Conv_Info.Record_Type);
         New_Type_Decl (Create_Identifier ("DTYPE"), Conv_Info.Record_Type);
         Conv_Info.Record_Ptr_Type := New_Access_Type (Conv_Info.Record_Type);
         New_Type_Decl (Create_Identifier ("DPTR"), Conv_Info.Record_Ptr_Type);

         --  Declare the subprogram.
         Start_Procedure_Decl
           (Inter_List, Create_Identifier, O_Storage_Private);
         New_Interface_Decl
           (Inter_List, Var_Data, Get_Identifier ("data"),
            Conv_Info.Record_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Conv_Info.Subprg);

         Start_Subprogram_Body (Conv_Info.Subprg);
         Push_Local_Factory;
         Open_Temp;

         --  Add an access to local block.
         V := Create_Temp_Init
           (Block_Info.Block_Decls_Ptr_Type,
            New_Value_Selected_Acc_Value (New_Obj (Var_Data),
                                          Conv_Info.Instance_Field));
         Push_Scope (Block_Info.Block_Decls_Type, V);

         --  Add an access to instantiated entity.
         --  This may be used to do some type checks.
         if Conv_Info.Instantiated_Entity /= Null_Iir then
            declare
               Ptr_Type : O_Tnode;
               Decl_Type : O_Tnode;
            begin
               if Entity_Info.Kind = Kind_Component then
                  Ptr_Type := Entity_Info.Comp_Ptr_Type;
                  Decl_Type := Entity_Info.Comp_Type;
               else
                  Ptr_Type := Entity_Info.Block_Decls_Ptr_Type;
                  Decl_Type := Entity_Info.Block_Decls_Type;
               end if;
               V := Create_Temp_Init
                 (Ptr_Type,
                  New_Value_Selected_Acc_Value (New_Obj (Var_Data),
                                                Conv_Info.Instantiated_Field));
               Push_Scope (Decl_Type, V);
            end;
         end if;

         --  Add access to the instantiation-specific data.
         --  This is used only for anonymous subtype variables.
         --  FIXME: what if STMT is a binding_indication ?
         Stmt_Info := Get_Info (Stmt);
         if Stmt_Info /= null
           and then Stmt_Info.Block_Decls_Type /= O_Tnode_Null
         then
            Push_Scope (Stmt_Info.Block_Decls_Type,
                        Stmt_Info.Block_Parent_Field,
                        Get_Info (Block).Block_Decls_Type);
         end if;

         --  Read signal value.
         E := New_Value_Selected_Acc_Value (New_Obj (Var_Data),
                                            Conv_Info.In_Field);
         case Mode is
            when Conv_Mode_In =>
               R := Chap7.Translate_Signal_Effective_Value (E, In_Type);
            when Conv_Mode_Out =>
               R := Chap7.Translate_Signal_Driving_Value (E, In_Type);
         end case;

         case Get_Kind (Imp) is
            when Iir_Kind_Function_Call =>
               Func := Get_Named_Entity (Get_Implementation (Imp));
               R := Chap7.Translate_Implicit_Conv
                 (R, In_Type,
                  Get_Type (Get_Interface_Declaration_Chain (Func)),
                  Mode_Value, Assoc);

               --  Create result value.
               Subprg_Info := Get_Info (Func);

               if Subprg_Info.Use_Stack2 then
                  Create_Temp_Stack2_Mark;
               end if;

               if Subprg_Info.Res_Interface /= O_Dnode_Null then
                  --  Composite result.
                  --  If we need to allocate, do it before starting the call!
                  declare
                     Res_Type : constant Iir := Get_Return_Type (Func);
                     Res_Info : constant Type_Info_Acc := Get_Info (Res_Type);
                  begin
                     Res := Create_Temp (Res_Info);
                     if Res_Info.Type_Mode /= Type_Mode_Fat_Array then
                        Chap4.Allocate_Complex_Object
                          (Res_Type, Alloc_Stack, Res);
                     end if;
                  end;
               end if;

               --  Call conversion function.
               Start_Association (Constr, Subprg_Info.Ortho_Func);

               if Subprg_Info.Res_Interface /= O_Dnode_Null then
                  --  Composite result.
                  New_Association (Constr, M2E (Res));
               end if;

               Chap2.Add_Subprg_Instance_Assoc
                 (Constr, Subprg_Info.Subprg_Instance);

               New_Association (Constr, R);

               if Subprg_Info.Res_Interface /= O_Dnode_Null then
                  --  Composite result.
                  New_Procedure_Call (Constr);
                  E := M2E (Res);
               else
                  E := New_Function_Call (Constr);
               end if;
               Res := E2M
                 (Chap7.Translate_Implicit_Conv
                    (E, Get_Return_Type (Func),
                     Out_Type, Mode_Value, Imp),
                  Get_Info (Out_Type), Mode_Value);

            when Iir_Kind_Type_Conversion =>
               declare
                  Conv_Type : Iir;
               begin
                  Conv_Type := Get_Type (Imp);
                  E := Chap7.Translate_Type_Conversion
                    (R, In_Type, Conv_Type, Assoc);
                  E := Chap7.Translate_Implicit_Conv
                    (E, Conv_Type, Out_Type, Mode_Value, Imp);
                  Res := E2M (E, Get_Info (Out_Type), Mode_Value);
               end;

            when others =>
               Error_Kind ("Translate_Association_Subprogram", Imp);
         end case;

         --  Assign signals.
         V1 := New_Selected_Acc_Value (New_Obj (Var_Data),
                                       Conv_Info.Out_Field);
         V_Out := Lo2M (V1, Out_Info, Mode_Signal);

         case Mode is
            when Conv_Mode_In =>
               Chap7.Set_Effective_Value (V_Out, Out_Type, Res);
            when Conv_Mode_Out =>
               Chap7.Set_Driving_Value (V_Out, Out_Type, Res);
         end case;

         Close_Temp;
         if Stmt_Info /= null
           and then Stmt_Info.Block_Decls_Type /= O_Tnode_Null
         then
            Pop_Scope (Stmt_Info.Block_Decls_Type);
         end if;
         if Conv_Info.Instantiated_Entity /= Null_Iir then
            if Entity_Info.Kind = Kind_Component then
               Pop_Scope (Entity_Info.Comp_Type);
            else
               Pop_Scope (Entity_Info.Block_Decls_Type);
            end if;
         end if;
         Pop_Scope (Block_Info.Block_Decls_Type);

         Pop_Local_Factory;
         Finish_Subprogram_Body;

         Pop_Identifier_Prefix (Mark3);
         Pop_Identifier_Prefix (Mark2);
      end Translate_Association_Subprogram;

      --  ENTITY is null for block_statement.
      procedure Translate_Association_Subprograms
        (Stmt : Iir; Block : Iir; Base_Block : Iir; Entity : Iir)
      is
         Assoc : Iir;
         Info : Assoc_Info_Acc;
      begin
         Assoc := Get_Port_Map_Aspect_Chain (Stmt);
         while Assoc /= Null_Iir loop
            if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression
            then
               Info := null;
               if Get_In_Conversion (Assoc) /= Null_Iir then
                  Info := Add_Info (Assoc, Kind_Assoc);
                  Translate_Association_Subprogram
                    (Stmt, Block, Assoc, Conv_Mode_In, Info.Assoc_In,
                     Base_Block, Entity);
               end if;
               if Get_Out_Conversion (Assoc) /= Null_Iir then
                  if Info = null then
                     Info := Add_Info (Assoc, Kind_Assoc);
                  end if;
                  Translate_Association_Subprogram
                    (Stmt, Block, Assoc, Conv_Mode_Out, Info.Assoc_Out,
                     Base_Block, Entity);
               end if;
            end if;
            Assoc := Get_Chain (Assoc);
         end loop;
      end Translate_Association_Subprograms;

      procedure Elab_Conversion (Sig_In : Iir;
                                 Sig_Out : Iir;
                                 Reg_Subprg : O_Dnode;
                                 Info : Assoc_Conv_Info;
                                 Ndest : out Mnode)
      is
         Out_Type : Iir;
         Out_Info : Type_Info_Acc;
         Ssig : Mnode;
         Constr : O_Assoc_List;
         Var_Data : O_Dnode;
         Data : Elab_Signal_Data;
      begin
         Out_Type := Get_Type (Sig_Out);
         Out_Info := Get_Info (Out_Type);

         --  Allocate data for the subprogram.
         Var_Data := Create_Temp (Info.Record_Ptr_Type);
         New_Assign_Stmt
           (New_Obj (Var_Data),
            Gen_Alloc (Alloc_System,
                       New_Lit (New_Sizeof (Info.Record_Type,
                                            Ghdl_Index_Type)),
                       Info.Record_Ptr_Type));

         --  Set instance.
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Var_Data), Info.Instance_Field),
            Get_Instance_Access (Info.Instance_Block));

         --  Set instantiated unit instance (if any).
         if Info.Instantiated_Entity /= Null_Iir then
            declare
               Inst_Addr : O_Enode;
               Inst_Info : Ortho_Info_Acc;
            begin
               if Get_Kind (Info.Instantiated_Entity)
                 = Iir_Kind_Component_Declaration
               then
                  Inst_Info := Get_Info (Info.Instantiated_Entity);
                  Inst_Addr := New_Address
                    (Get_Instance_Ref (Inst_Info.Comp_Type),
                     Inst_Info.Comp_Ptr_Type);
               else
                  Inst_Addr := Get_Instance_Access (Info.Instantiated_Entity);
               end if;
               New_Assign_Stmt
                 (New_Selected_Acc_Value (New_Obj (Var_Data),
                                          Info.Instantiated_Field),
                  Inst_Addr);
            end;
         end if;

         --  Set input.
         Ssig := Chap6.Translate_Name (Sig_In);
         Ssig := Stabilize (Ssig, True);

         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Var_Data), Info.In_Field),
            M2E (Ssig));

         --  Create a copy of SIG_OUT.
         Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data),
                                                Info.Out_Field),
                        Out_Info, Mode_Signal);
         Chap4.Allocate_Complex_Object (Out_Type, Alloc_System, Ndest);
         --  Note: NDEST will be assigned by ELAB_SIGNAL.
         Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data),
                                                Info.Out_Field),
                        Out_Info, Mode_Signal);
         Data := Elab_Signal_Data'(Has_Val => False,
                                   Already_Resolved => True,
                                   Val => Mnode_Null,
                                   Check_Null => False,
                                   If_Stmt => null);
         Elab_Signal (Ndest, Out_Type, Data);

         Ndest := Lo2M (New_Selected_Acc_Value (New_Obj (Var_Data),
                                                Info.Out_Field),
                        Out_Info, Mode_Signal);
         Ndest := Stabilize (Ndest, True);

         --  Register.
         Start_Association (Constr, Reg_Subprg);
         New_Association
           (Constr, New_Lit (New_Subprogram_Address (Info.Subprg,
                                                     Ghdl_Ptr_Type)));
         New_Association
           (Constr, New_Convert_Ov (New_Obj_Value (Var_Data), Ghdl_Ptr_Type));

         New_Association
           (Constr,
            New_Convert_Ov (M2E (Get_Leftest_Signal (Ssig, Get_Type (Sig_In))),
                                 Ghdl_Signal_Ptr));
         New_Association (Constr, Get_Nbr_Signals (Ssig, Get_Type (Sig_In)));

         New_Association
           (Constr,
            New_Convert_Ov
            (M2E (Get_Leftest_Signal (Ndest, Get_Type (Sig_Out))),
                  Ghdl_Signal_Ptr));
         New_Association (Constr, Get_Nbr_Signals (Ndest, Get_Type (Sig_Out)));

         New_Procedure_Call (Constr);
      end Elab_Conversion;

      --  In conversion: from actual to formal.
      procedure Elab_In_Conversion (Assoc : Iir; Ndest : out Mnode)
      is
         Assoc_Info : Assoc_Info_Acc;
      begin
         Assoc_Info := Get_Info (Assoc);

         Elab_Conversion
           (Get_Actual (Assoc), Get_Formal (Assoc),
            Ghdl_Signal_In_Conversion, Assoc_Info.Assoc_In, Ndest);
      end Elab_In_Conversion;

      --  Out conversion: from formal to actual.
      procedure Elab_Out_Conversion (Assoc : Iir; Ndest : out Mnode)
      is
         Assoc_Info : Assoc_Info_Acc;
      begin
         Assoc_Info := Get_Info (Assoc);

         Elab_Conversion
           (Get_Formal (Assoc), Get_Actual (Assoc),
            Ghdl_Signal_Out_Conversion, Assoc_Info.Assoc_Out, Ndest);
      end Elab_Out_Conversion;

      --  Create a record that describe thes location of an IIR node and
      --  returns the address of it.
      function Get_Location (N : Iir) return O_Dnode
      is
         Constr : O_Record_Aggr_List;
         Aggr : O_Cnode;
         Name : Name_Id;
         Line : Natural;
         Col : Natural;
         C : O_Dnode;
      begin
         Files_Map.Location_To_Position (Get_Location (N), Name, Line, Col);

         New_Const_Decl (C, Create_Uniq_Identifier, O_Storage_Private,
                         Ghdl_Location_Type_Node);
         Start_Const_Value (C);
         Start_Record_Aggr (Constr, Ghdl_Location_Type_Node);
         New_Record_Aggr_El
           (Constr, New_Global_Address (Current_Filename_Node, Char_Ptr_Type));
         New_Record_Aggr_El (Constr, New_Signed_Literal (Ghdl_I32_Type,
                                                         Integer_64 (Line)));
         New_Record_Aggr_El (Constr, New_Signed_Literal (Ghdl_I32_Type,
                                                         Integer_64 (Col)));
         Finish_Record_Aggr (Constr, Aggr);
         Finish_Const_Value (C, Aggr);

         return C;
         --return New_Global_Address (C, Ghdl_Location_Ptr_Node);
      end Get_Location;
   end Chap4;

   package body Chap5 is
      procedure Translate_Attribute_Specification
        (Spec : Iir_Attribute_Specification)
      is
         Attr : constant Iir_Attribute_Declaration :=
           Get_Named_Entity (Get_Attribute_Designator (Spec));
         Atinfo : constant Type_Info_Acc := Get_Info (Get_Type (Attr));
         Mark : Id_Mark_Type;
         Info : Object_Info_Acc;
      begin
         Push_Identifier_Prefix_Uniq (Mark);
         Info := Add_Info (Spec, Kind_Object);
         Info.Object_Var := Create_Var
           (Create_Var_Identifier (Attr),
            Chap4.Get_Object_Type (Atinfo, Mode_Value),
            Global_Storage);
         Pop_Identifier_Prefix (Mark);
      end Translate_Attribute_Specification;

      procedure Elab_Attribute_Specification
        (Spec : Iir_Attribute_Specification)
      is
         Attr : constant Iir_Attribute_Declaration :=
           Get_Named_Entity (Get_Attribute_Designator (Spec));
      begin
         --  Kludge
         Set_Info (Attr, Get_Info (Spec));
         Chap4.Elab_Object_Value (Attr, Get_Expression (Spec));
         Clear_Info (Attr);
      end Elab_Attribute_Specification;

      procedure Gen_Elab_Disconnect_Non_Composite (Targ : Mnode;
                                                   Targ_Type : Iir;
                                                   Time : O_Dnode)
      is
         pragma Unreferenced (Targ_Type);
         Assoc : O_Assoc_List;
      begin
         Start_Association (Assoc, Ghdl_Signal_Set_Disconnect);
         New_Association
           (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
         New_Association (Assoc, New_Obj_Value (Time));
         New_Procedure_Call (Assoc);
      end Gen_Elab_Disconnect_Non_Composite;

      function Gen_Elab_Disconnect_Prepare
        (Targ : Mnode; Targ_Type : Iir; Time : O_Dnode)
        return O_Dnode
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Time;
      end Gen_Elab_Disconnect_Prepare;

      function Gen_Elab_Disconnect_Update_Data_Array (Time : O_Dnode;
                                                      Targ_Type : Iir;
                                                      Index : O_Dnode)
                                                     return O_Dnode
      is
         pragma Unreferenced (Targ_Type, Index);
      begin
         return Time;
      end Gen_Elab_Disconnect_Update_Data_Array;

      function Gen_Elab_Disconnect_Update_Data_Record
        (Time : O_Dnode; Targ_Type : Iir; El : Iir_Element_Declaration)
        return O_Dnode
      is
         pragma Unreferenced (Targ_Type, El);
      begin
         return Time;
      end Gen_Elab_Disconnect_Update_Data_Record;

      procedure Gen_Elab_Disconnect_Finish_Data_Composite
        (Data : in out O_Dnode)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Gen_Elab_Disconnect_Finish_Data_Composite;

      procedure Gen_Elab_Disconnect is new Foreach_Non_Composite
        (Data_Type => O_Dnode,
         Composite_Data_Type => O_Dnode,
         Do_Non_Composite => Gen_Elab_Disconnect_Non_Composite,
         Prepare_Data_Array => Gen_Elab_Disconnect_Prepare,
         Update_Data_Array => Gen_Elab_Disconnect_Update_Data_Array,
         Finish_Data_Array => Gen_Elab_Disconnect_Finish_Data_Composite,
         Prepare_Data_Record => Gen_Elab_Disconnect_Prepare,
         Update_Data_Record => Gen_Elab_Disconnect_Update_Data_Record,
         Finish_Data_Record => Gen_Elab_Disconnect_Finish_Data_Composite);

      procedure Elab_Disconnection_Specification
        (Spec : Iir_Disconnection_Specification)
      is
         Val : O_Dnode;
         List : constant Iir_List := Get_Signal_List (Spec);
         El : Iir;
      begin
         Val := Create_Temp_Init
           (Std_Time_Type, Chap7.Translate_Expression (Get_Expression (Spec)));
         for I in Natural loop
            El := Get_Nth_Element (List, I);
            exit when El = Null_Iir;
            Gen_Elab_Disconnect (Chap6.Translate_Name (El),
                                 Get_Type (El), Val);
         end loop;
      end Elab_Disconnection_Specification;

      type Connect_Mode is
        (
         --  Actual is a source for the formal.
         Connect_Source,

         --  Both.
         Connect_Both,

         --  Effective value of actual is the effective value of the formal.
         Connect_Effective,

         --  Actual is a value.
         Connect_Value
        );

      type Connect_Data is record
         Actual_Node : Mnode;
         Actual_Type : Iir;

         --  Mode of the connection.
         Mode : Connect_Mode;

         --  If true, formal signal is a copy of the actual.
         By_Copy : Boolean;
      end record;

      --  Connect_effective: FORMAL is set from ACTUAL.
      --  Connect_Source: ACTUAL is set from FORMAL (source of ACTUAL).
      procedure Connect_Scalar (Formal_Node : Mnode;
                                Formal_Type : Iir;
                                Data : Connect_Data)
      is
         Act_Node, Form_Node : Mnode;
      begin
         if Data.By_Copy then
            New_Assign_Stmt (M2Lv (Formal_Node), M2E (Data.Actual_Node));
            return;
         end if;

         case Data.Mode is
            when Connect_Both =>
               Open_Temp;
               Act_Node := Stabilize (Data.Actual_Node, True);
               Form_Node := Stabilize (Formal_Node, True);
            when Connect_Source
              | Connect_Effective =>
               Act_Node := Data.Actual_Node;
               Form_Node := Formal_Node;
            when Connect_Value =>
               null;
         end case;

         if Data.Mode in Connect_Source .. Connect_Both then
            --  Formal is a source to actual.
            declare
               Constr : O_Assoc_List;
            begin
               Start_Association (Constr, Ghdl_Signal_Add_Source);
               New_Association (Constr, New_Convert_Ov (M2E (Act_Node),
                                                        Ghdl_Signal_Ptr));
               New_Association (Constr, New_Convert_Ov (M2E (Form_Node),
                                                        Ghdl_Signal_Ptr));
               New_Procedure_Call (Constr);
            end;
         end if;

         if Data.Mode in Connect_Both .. Connect_Effective then
            --  The effective value of formal is the effective value of actual.
            declare
               Constr : O_Assoc_List;
            begin
               Start_Association (Constr, Ghdl_Signal_Effective_Value);
               New_Association (Constr, New_Convert_Ov (M2E (Form_Node),
                                                        Ghdl_Signal_Ptr));
               New_Association (Constr, New_Convert_Ov (M2E (Act_Node),
                                                        Ghdl_Signal_Ptr));
               New_Procedure_Call (Constr);
            end;
         end if;

         if Data.Mode = Connect_Value then
            declare
               Type_Info : Type_Info_Acc;
               Subprg : O_Dnode;
               Constr : O_Assoc_List;
               Conv : O_Tnode;
            begin
               Type_Info := Get_Info (Formal_Type);
               case Type_Info.Type_Mode is
                  when Type_Mode_B2 =>
                     Subprg := Ghdl_Signal_Associate_B2;
                     Conv := Ghdl_Bool_Type;
                  when Type_Mode_E8 =>
                     Subprg := Ghdl_Signal_Associate_E8;
                     Conv := Ghdl_I32_Type;
                  when Type_Mode_E32 =>
                     Subprg := Ghdl_Signal_Associate_E32;
                     Conv := Ghdl_I32_Type;
                  when Type_Mode_I32 =>
                     Subprg := Ghdl_Signal_Associate_I32;
                     Conv := Ghdl_I32_Type;
                  when Type_Mode_P64 =>
                     Subprg := Ghdl_Signal_Associate_I64;
                     Conv := Ghdl_I64_Type;
                  when Type_Mode_F64 =>
                     Subprg := Ghdl_Signal_Associate_F64;
                     Conv := Ghdl_Real_Type;
                  when others =>
                     Error_Kind ("connect_scalar", Formal_Type);
               end case;
               Start_Association (Constr, Subprg);
               New_Association (Constr,
                                New_Convert_Ov (New_Value (M2Lv (Formal_Node)),
                                                Ghdl_Signal_Ptr));
               New_Association (Constr,
                                New_Convert_Ov (M2E (Data.Actual_Node), Conv));
               New_Procedure_Call (Constr);
            end;
         end if;

         if Data.Mode = Connect_Both then
            Close_Temp;
         end if;
      end Connect_Scalar;

      function Connect_Prepare_Data_Composite
        (Targ : Mnode; Formal_Type : Iir; Data : Connect_Data)
        return Connect_Data
      is
         pragma Unreferenced (Targ, Formal_Type);
         Res : Connect_Data;
         Atype : Iir;
      begin
         Atype := Get_Base_Type (Data.Actual_Type);
         if Get_Kind (Atype) = Iir_Kind_Record_Type_Definition then
            Res := Data;
            Stabilize (Res.Actual_Node);
            return Res;
         else
            return Data;
         end if;
      end Connect_Prepare_Data_Composite;

      function Connect_Update_Data_Array (Data : Connect_Data;
                                          Formal_Type : Iir;
                                          Index : O_Dnode)
        return Connect_Data
      is
         pragma Unreferenced (Formal_Type);
         Res : Connect_Data;
      begin
         --  FIXME: should check matching elements!
         Res := (Actual_Node =>
                   Chap3.Index_Base (Chap3.Get_Array_Base (Data.Actual_Node),
                                     Data.Actual_Type, New_Obj_Value (Index)),
                 Actual_Type => Get_Element_Subtype (Data.Actual_Type),
                 Mode => Data.Mode,
                 By_Copy => Data.By_Copy);
         return Res;
      end Connect_Update_Data_Array;

      function Connect_Update_Data_Record (Data : Connect_Data;
                                           Formal_Type : Iir;
                                           El : Iir_Element_Declaration)
        return Connect_Data
      is
         pragma Unreferenced (Formal_Type);
         Res : Connect_Data;
      begin
         Res := (Actual_Node =>
                   Chap6.Translate_Selected_Element (Data.Actual_Node, El),
                 Actual_Type => Get_Type (El),
                 Mode => Data.Mode,
                 By_Copy => Data.By_Copy);
         return Res;
      end Connect_Update_Data_Record;

      procedure Connect_Finish_Data_Composite (Data : in out Connect_Data)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Connect_Finish_Data_Composite;

      procedure Connect is new Foreach_Non_Composite
        (Data_Type => Connect_Data,
         Composite_Data_Type => Connect_Data,
         Do_Non_Composite => Connect_Scalar,
         Prepare_Data_Array => Connect_Prepare_Data_Composite,
         Update_Data_Array => Connect_Update_Data_Array,
         Finish_Data_Array => Connect_Finish_Data_Composite,
         Prepare_Data_Record => Connect_Prepare_Data_Composite,
         Update_Data_Record => Connect_Update_Data_Record,
         Finish_Data_Record => Connect_Finish_Data_Composite);

      procedure Elab_Unconstrained_Port (Port : Iir; Actual : Iir)
      is
         Act_Node : Mnode;
         Bounds : Mnode;
         Tinfo : Type_Info_Acc;
         Bound_Var : O_Dnode;
         Actual_Type : Iir;
      begin
         Actual_Type := Get_Type (Actual);
         Open_Temp;
         if Is_Fully_Constrained_Type (Actual_Type) then
            Chap3.Create_Array_Subtype (Actual_Type, False);
            Tinfo := Get_Info (Actual_Type);
            Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type);
            if Get_Alloc_Kind_For_Var (Tinfo.T.Array_Bounds) = Alloc_Stack then
               --  We need a copy.
               Bound_Var := Create_Temp (Tinfo.T.Bounds_Ptr_Type);
               New_Assign_Stmt
                 (New_Obj (Bound_Var),
                  Gen_Alloc (Alloc_System,
                             New_Lit (New_Sizeof (Tinfo.T.Bounds_Type,
                                                  Ghdl_Index_Type)),
                             Tinfo.T.Bounds_Ptr_Type));
               Gen_Memcpy (New_Obj_Value (Bound_Var),
                           M2Addr (Bounds),
                           New_Lit (New_Sizeof (Tinfo.T.Bounds_Type,
                                                Ghdl_Index_Type)));
               Bounds := Dp2M (Bound_Var, Tinfo, Mode_Value,
                               Tinfo.T.Bounds_Type,
                               Tinfo.T.Bounds_Ptr_Type);
            end if;
         else
            Bounds := Chap3.Get_Array_Bounds (Chap6.Translate_Name (Actual));
         end if;
         Act_Node := Chap6.Translate_Name (Port);
         New_Assign_Stmt
           (-- FIXME: this works only because it is not stabilized,
            -- and therefore the bounds field is returned and not
            -- a pointer to the bounds.
            M2Lp (Chap3.Get_Array_Bounds (Act_Node)),
            M2Addr (Bounds));
         Close_Temp;
      end Elab_Unconstrained_Port;

      --  Return TRUE if EXPR is a signal name.
      function Is_Signal (Expr : Iir) return Boolean
      is
         Obj : Iir;
      begin
         Obj := Sem_Names.Name_To_Object (Expr);
         if Obj /= Null_Iir then
            return Is_Signal_Object (Obj);
         else
            return False;
         end if;
      end Is_Signal;

      procedure Elab_Port_Map_Aspect_Assoc (Assoc : Iir; By_Copy : Boolean)
      is
         Formal : constant Iir := Get_Formal (Assoc);
         Actual : constant Iir := Get_Actual (Assoc);
         Formal_Type : constant Iir := Get_Type (Formal);
         Actual_Type : constant Iir := Get_Type (Actual);
         Inter : constant Iir := Get_Association_Interface (Assoc);
         Formal_Node, Actual_Node : Mnode;
         Data : Connect_Data;
         Mode : Connect_Mode;
      begin
         if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Expression then
            raise Internal_Error;
         end if;

         Open_Temp;
         if Get_In_Conversion (Assoc) = Null_Iir
           and then Get_Out_Conversion (Assoc) = Null_Iir
         then
            Formal_Node := Chap6.Translate_Name (Formal);
            if Get_Object_Kind (Formal_Node) /= Mode_Signal then
               raise Internal_Error;
            end if;
            if Is_Signal (Actual) then
               --  LRM93 4.3.1.2
               --  For a signal of a scalar type, each source is either
               --  a driver or an OUT, INOUT, BUFFER or LINKAGE port of
               --  a component instance or of a block statement with
               --  which the signalis associated.

               --  LRM93 12.6.2
               --  For a scalar signal S, the effective value of S is
               --  determined in the following manner:
               --  *  If S is [...] a port of mode BUFFER or [...],
               --     then the effective value of S is the same as
               --     the driving value of S.
               --  *  If S is a connected port of mode IN or INOUT,
               --     then the effective value of S is the same as
               --     the effective value of the actual part of the
               --     association element that associates an actual
               --     with S.
               --  *  [...]
               case Get_Mode (Inter) is
                  when Iir_In_Mode =>
                     Mode := Connect_Effective;
                  when Iir_Inout_Mode =>
                     Mode := Connect_Both;
                  when Iir_Out_Mode
                    | Iir_Buffer_Mode
                    | Iir_Linkage_Mode =>
                     Mode := Connect_Source;
                  when Iir_Unknown_Mode =>
                     raise Internal_Error;
               end case;

               --  translate actual (abort if not a signal).
               Actual_Node := Chap6.Translate_Name (Actual);
               if Get_Object_Kind (Actual_Node) /= Mode_Signal then
                  raise Internal_Error;
               end if;
            else
               declare
                  Actual_Val : O_Enode;
               begin
                  Actual_Val := Chap7.Translate_Expression
                    (Actual, Formal_Type);
                  Actual_Node := E2M
                    (Actual_Val, Get_Info (Formal_Type), Mode_Value);
                  Mode := Connect_Value;
               end;
            end if;

            if Get_Kind (Formal_Type) in Iir_Kinds_Array_Type_Definition
            then
               --  Check length matches.
               Stabilize (Formal_Node);
               Stabilize (Actual_Node);
               Chap3.Check_Array_Match (Formal_Type, Formal_Node,
                                        Actual_Type, Actual_Node,
                                        Assoc);
            end if;

            Data := (Actual_Node => Actual_Node,
                     Actual_Type => Actual_Type,
                     Mode => Mode,
                     By_Copy => By_Copy);
            Connect (Formal_Node, Formal_Type, Data);
         else
            if Get_In_Conversion (Assoc) /= Null_Iir then
               Chap4.Elab_In_Conversion (Assoc, Actual_Node);
               Formal_Node := Chap6.Translate_Name (Formal);
               Data := (Actual_Node => Actual_Node,
                        Actual_Type => Formal_Type,
                        Mode => Connect_Effective,
                        By_Copy => False);
               Connect (Formal_Node, Formal_Type, Data);
            end if;
            if Get_Out_Conversion (Assoc) /= Null_Iir then
               --  flow: FORMAL to ACTUAL
               Chap4.Elab_Out_Conversion (Assoc, Formal_Node);
               Actual_Node := Chap6.Translate_Name (Actual);
               Data := (Actual_Node => Actual_Node,
                        Actual_Type => Actual_Type,
                        Mode => Connect_Source,
                        By_Copy => False);
               Connect (Formal_Node, Actual_Type, Data);
            end if;
         end if;

         Close_Temp;
      end Elab_Port_Map_Aspect_Assoc;

      --  Return TRUE if the collapse_signal_flag is set for each individual
      --  association.
      function Inherit_Collapse_Flag (Assoc : Iir) return Boolean
      is
         El : Iir;
      begin
         case Get_Kind (Assoc) is
            when Iir_Kind_Association_Element_By_Individual =>
               El := Get_Individual_Association_Chain (Assoc);
               while El /= Null_Iir loop
                  if Inherit_Collapse_Flag (El) = False then
                     return False;
                  end if;
                  El := Get_Chain (El);
               end loop;
               return True;
            when Iir_Kind_Choice_By_Expression
              | Iir_Kind_Choice_By_Range
              | Iir_Kind_Choice_By_Name =>
               El := Assoc;
               while El /= Null_Iir loop
                  if Inherit_Collapse_Flag (Get_Associated (Assoc)) = False
                  then
                     return False;
                  end if;
                  El := Get_Chain (El);
               end loop;
               return True;
            when Iir_Kind_Association_Element_By_Expression =>
               return Get_Collapse_Signal_Flag (Assoc);
            when others =>
               Error_Kind ("inherit_collapse_flag", Assoc);
         end case;
      end Inherit_Collapse_Flag;

      procedure Elab_Map_Aspect (Mapping : Iir; Block_Parent : Iir)
      is
         Assoc : Iir;
         Formal : Iir;
         Formal_Base : Iir;
         Fb_Type : Iir;
         Fbt_Info : Type_Info_Acc;
         Collapse_Individual : Boolean := False;
         Targ : Mnode;
      begin
         --  Elab generics, and associate.
         --  The generic map must be done before the elaboration of
         --  the ports, since a port subtype may depend on a generic.
         Assoc := Get_Generic_Map_Aspect_Chain (Mapping);
         while Assoc /= Null_Iir loop
            Open_Temp;
            Formal := Get_Formal (Assoc);
            if Get_Kind (Formal) in Iir_Kinds_Denoting_Name then
               Formal := Get_Named_Entity (Formal);
            end if;
            case Get_Kind (Assoc) is
               when Iir_Kind_Association_Element_By_Expression =>
                  if Get_Whole_Association_Flag (Assoc) then
                     Chap4.Elab_Object_Storage (Formal);
                     Targ := Chap6.Translate_Name (Formal);
                     Chap4.Elab_Object_Init (Targ, Formal, Get_Actual (Assoc));
                  else
                     Targ := Chap6.Translate_Name (Formal);
                     Chap7.Translate_Assign
                       (Targ, Get_Actual (Assoc), Get_Type (Formal));
                  end if;
               when Iir_Kind_Association_Element_Open =>
                  Chap4.Elab_Object_Value (Formal, Get_Default_Value (Formal));
               when Iir_Kind_Association_Element_By_Individual =>
                  --  Create the object.
                  declare
                     Formal_Node : Mnode;
                     Formal_Type : Iir;
                     Obj_Info : Object_Info_Acc;
                     Obj_Type : Iir;
                     Type_Info : Type_Info_Acc;
                     Bounds : O_Enode;
                  begin
                     Formal_Type := Get_Type (Formal);
                     Chap3.Elab_Object_Subtype (Formal_Type);
                     Type_Info := Get_Info (Formal_Type);
                     Obj_Info := Get_Info (Formal);
                     Formal_Node := Get_Var
                       (Obj_Info.Object_Var, Type_Info, Mode_Value);
                     Stabilize (Formal_Node);
                     Obj_Type := Get_Actual_Type (Assoc);
                     if Obj_Type = Null_Iir then
                        Chap4.Allocate_Complex_Object
                          (Formal_Type, Alloc_System, Formal_Node);
                     else
                        Chap3.Create_Array_Subtype (Obj_Type, False);
                        Bounds := M2E (Chap3.Get_Array_Type_Bounds (Obj_Type));
                        Chap3.Translate_Object_Allocation
                          (Formal_Node, Alloc_System, Formal_Type, Bounds);
                     end if;
                  end;
               when others =>
                  Error_Kind ("elab_map_aspect(1)", Assoc);
            end case;
            Close_Temp;
            Assoc := Get_Chain (Assoc);
         end loop;

         --  Ports.
         Assoc := Get_Port_Map_Aspect_Chain (Mapping);
         while Assoc /= Null_Iir loop
            Formal := Get_Formal (Assoc);
            Formal_Base := Get_Association_Interface (Assoc);
            Fb_Type := Get_Type (Formal_Base);

            Open_Temp;
            --  Set bounds of unconstrained ports.
            Fbt_Info := Get_Info (Fb_Type);
            if Fbt_Info.Type_Mode = Type_Mode_Fat_Array then
               case Get_Kind (Assoc) is
                  when Iir_Kind_Association_Element_By_Expression =>
                     if Get_Whole_Association_Flag (Assoc) then
                        Elab_Unconstrained_Port (Formal, Get_Actual (Assoc));
                     end if;
                  when Iir_Kind_Association_Element_Open =>
                     declare
                        Actual_Type : Iir;
                        Bounds : Mnode;
                        Formal_Node : Mnode;
                     begin
                        Actual_Type :=
                          Get_Type (Get_Default_Value (Formal_Base));
                        Chap3.Create_Array_Subtype (Actual_Type, True);
                        Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type);
                        Formal_Node := Chap6.Translate_Name (Formal);
                        New_Assign_Stmt
                          (M2Lp (Chap3.Get_Array_Bounds (Formal_Node)),
                           M2Addr (Bounds));
                     end;
                  when Iir_Kind_Association_Element_By_Individual =>
                     declare
                        Actual_Type : Iir;
                        Bounds : Mnode;
                        Formal_Node : Mnode;
                     begin
                        Actual_Type := Get_Actual_Type (Assoc);
                        Chap3.Create_Array_Subtype (Actual_Type, False);
                        Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type);
                        Formal_Node := Chap6.Translate_Name (Formal);
                        New_Assign_Stmt
                          (M2Lp (Chap3.Get_Array_Bounds (Formal_Node)),
                           M2Addr (Bounds));
                     end;
               when others =>
                  Error_Kind ("elab_map_aspect(2)", Assoc);
               end case;
            end if;
            Close_Temp;

            --  Allocate storage of ports.
            Open_Temp;
            case Get_Kind (Assoc) is
               when Iir_Kind_Association_Element_By_Individual
                 | Iir_Kind_Association_Element_Open =>
                  Chap4.Elab_Signal_Declaration_Storage (Formal);
               when Iir_Kind_Association_Element_By_Expression =>
                  if Get_Whole_Association_Flag (Assoc) then
                     Chap4.Elab_Signal_Declaration_Storage (Formal);
                  end if;
               when others =>
                  Error_Kind ("elab_map_aspect(3)", Assoc);
            end case;
            Close_Temp;

            --  Create or copy signals.
            Open_Temp;
            case Get_Kind (Assoc) is
               when Iir_Kind_Association_Element_By_Expression =>
                  if Get_Whole_Association_Flag (Assoc) then
                     if Get_Collapse_Signal_Flag (Assoc) then
                        --  For collapsed association, copy signals.
                        Elab_Port_Map_Aspect_Assoc (Assoc, True);
                     else
                        --  Create non-collapsed signals.
                        Chap4.Elab_Signal_Declaration_Object
                          (Formal, Block_Parent, False);
                        --  And associate.
                        Elab_Port_Map_Aspect_Assoc (Assoc, False);
                     end if;
                  else
                     --  By sub-element.
                     --  Either the whole signal is collapsed or it was already
                     --  created.
                     --  And associate.
                     Elab_Port_Map_Aspect_Assoc (Assoc, Collapse_Individual);
                  end if;
               when Iir_Kind_Association_Element_Open =>
                  --  Create non-collapsed signals.
                  Chap4.Elab_Signal_Declaration_Object
                    (Formal, Block_Parent, False);
               when Iir_Kind_Association_Element_By_Individual =>
                  --  Inherit the collapse flag.
                  --  If it is set for all sub-associations, continue.
                  --  Otherwise, create signals and do not collapse.
                  --  FIXME: this may be slightly optimized.
                  if not Inherit_Collapse_Flag (Assoc) then
                     --  Create the formal.
                     Chap4.Elab_Signal_Declaration_Object
                       (Formal, Block_Parent, False);
                     Collapse_Individual := False;
                  else
                     Collapse_Individual := True;
                  end if;
               when others =>
                  Error_Kind ("elab_map_aspect(4)", Assoc);
            end case;
            Close_Temp;

            Assoc := Get_Chain (Assoc);
         end loop;
      end Elab_Map_Aspect;

   end Chap5;

   package body Chap6 is
      --  Extract from fat array FAT_ARRAY the range corresponding to dimension
      --  DIM.
      function Fat_Array_To_Range (Fat_Array : O_Lnode;
                                   Array_Type : Iir;
                                   Dim : Natural;
                                   Is_Sig : Object_Kind_Type)
        return O_Lnode
      is
         Lval : O_Lnode;
         Array_Info : Type_Info_Acc;
      begin
         Array_Info := Get_Info (Array_Type);
         case Array_Info.Type_Mode is
            when Type_Mode_Fat_Array =>
               --  From fat record, extract bounds field.
               Lval := New_Selected_Element
                 (Fat_Array, Array_Info.T.Bounds_Field (Is_Sig));
               --  Dereference it.
               Lval := New_Access_Element (New_Value (Lval));
            when Type_Mode_Array =>
               Lval := Get_Var (Array_Info.T.Array_Bounds);
            when others =>
               raise Internal_Error;
         end case;
         --  Extract the range for the dimension.
         return New_Selected_Element (Lval, Array_Info.T.Bounds_Vector (Dim));
      end Fat_Array_To_Range;

      function Get_Array_Bound_Length (Arr : O_Lnode;
                                       Arr_Type : Iir;
                                       Dim : Natural;
                                       Is_Sig : Object_Kind_Type)
        return O_Enode
      is
         Index_Type : constant Iir := Get_Index_Type (Arr_Type, Dim - 1);
         Tinfo : constant Type_Info_Acc := Get_Info (Arr_Type);
         Rinfo : Type_Info_Acc;
         Constraint : Iir;
      begin
         if Tinfo.Type_Locally_Constrained then
            Constraint := Get_Range_Constraint (Index_Type);
            return New_Lit (Chap7.Translate_Static_Range_Length (Constraint));
         else
            Rinfo := Get_Info (Get_Base_Type (Index_Type));
            return New_Value
              (New_Selected_Element
                 (Fat_Array_To_Range (Arr, Arr_Type, Dim, Is_Sig),
                  Rinfo.T.Range_Length));
         end if;
      end Get_Array_Bound_Length;

      function Get_Array_Ptr_Bound_Length (Ptr : O_Lnode;
                                           Arr_Type : Iir;
                                           Dim : Natural;
                                           Is_Sig : Object_Kind_Type)
        return O_Enode
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Info (Arr_Type);
         case Tinfo.Type_Mode is
            when Type_Mode_Fat_Array =>
               return Get_Array_Bound_Length
                 (New_Acc_Value (Ptr), Arr_Type, Dim, Is_Sig);
            when Type_Mode_Array =>
               return Get_Array_Bound_Length
                 (O_Lnode_Null, Arr_Type, Dim, Is_Sig);
            when others =>
               raise Internal_Error;
         end case;
      end Get_Array_Ptr_Bound_Length;

      procedure Gen_Bound_Error (Loc : Iir)
      is
         Constr : O_Assoc_List;
         Name : Name_Id;
         Line, Col : Natural;
      begin
         Files_Map.Location_To_Position (Get_Location (Loc), Name, Line, Col);

         Start_Association (Constr, Ghdl_Bound_Check_Failed_L1);
         Assoc_Filename_Line (Constr, Line);
         New_Procedure_Call (Constr);
      end Gen_Bound_Error;

      procedure Gen_Program_Error (Loc : Iir; Code : Natural)
      is
         Assoc : O_Assoc_List;
      begin
         Start_Association (Assoc, Ghdl_Program_Error);

         if Current_Filename_Node = O_Dnode_Null then
            New_Association (Assoc, New_Lit (New_Null_Access (Char_Ptr_Type)));
            New_Association (Assoc,
                             New_Lit (New_Signed_Literal (Ghdl_I32_Type, 0)));
         else
            Assoc_Filename_Line (Assoc, Get_Line_Number (Loc));
         end if;
         New_Association
           (Assoc, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
                                                  Unsigned_64 (Code))));
         New_Procedure_Call (Assoc);
      end Gen_Program_Error;

      --  Generate code to emit a failure if COND is TRUE, indicating an
      --  index violation for dimension DIM of an array.  LOC is usually
      --  the expression which has computed the index and is used only for
      --  its location.
      procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir; Dim : Natural)
      is
         pragma Unreferenced (Dim);
         If_Blk : O_If_Block;
      begin
         Start_If_Stmt (If_Blk, Cond);
         Gen_Bound_Error (Loc);
         Finish_If_Stmt (If_Blk);
      end Check_Bound_Error;

      --  Return TRUE if an array whose index type is RNG_TYPE indexed by
      --  an expression of type EXPR_TYPE needs a bound check.
      function Need_Index_Check (Expr_Type : Iir; Rng_Type : Iir)
                                return Boolean
      is
         Rng : Iir;
      begin
         --  Do checks if type of the expression is not a subtype.
         --  FIXME: EXPR_TYPE shound not be NULL_IIR (generate stmt)
         if Expr_Type = Null_Iir then
            return True;
         end if;
         case Get_Kind (Expr_Type) is
            when Iir_Kind_Integer_Subtype_Definition
              | Iir_Kind_Enumeration_Subtype_Definition
              | Iir_Kind_Enumeration_Type_Definition =>
               null;
            when others =>
               return True;
         end case;

         --  No check if the expression has the type of the index.
         if Expr_Type = Rng_Type then
            return False;
         end if;

         --  No check for 'Range or 'Reverse_Range.
         Rng := Get_Range_Constraint (Expr_Type);
         if (Get_Kind (Rng) = Iir_Kind_Range_Array_Attribute
             or Get_Kind (Rng) = Iir_Kind_Reverse_Range_Array_Attribute)
           and then Get_Type (Rng) = Rng_Type
         then
            return False;
         end if;

         return True;
      end Need_Index_Check;

      procedure Get_Deep_Range_Expression
        (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean)
      is
         T : Iir;
         R : Iir;
      begin
         Is_Reverse := False;

         --  T is an integer/enumeration subtype.
         T := Atype;
         loop
            case Get_Kind (T) is
               when Iir_Kind_Integer_Subtype_Definition
                 | Iir_Kind_Enumeration_Subtype_Definition
                 | Iir_Kind_Enumeration_Type_Definition =>
                  --  These types have a range.
                  null;
               when others =>
                  Error_Kind ("get_deep_range_expression(1)", T);
            end case;

            R := Get_Range_Constraint (T);
            case Get_Kind (R) is
               when Iir_Kind_Range_Expression =>
                  Rng := R;
                  return;
               when Iir_Kind_Range_Array_Attribute =>
                  null;
               when Iir_Kind_Reverse_Range_Array_Attribute =>
                  Is_Reverse := not Is_Reverse;
               when others =>
                  Error_Kind ("get_deep_range_expression(2)", R);
            end case;
            T := Get_Index_Subtype (R);
            if T = Null_Iir then
               Rng := Null_Iir;
               return;
            end if;
         end loop;
      end Get_Deep_Range_Expression;

      function Translate_Index_To_Offset (Rng : Mnode;
                                          Index : O_Enode;
                                          Index_Expr : Iir;
                                          Range_Type : Iir;
                                          Loc : Iir)
                                         return O_Enode
      is
         Need_Check : Boolean;
         Dir : O_Enode;
         If_Blk : O_If_Block;
         Res : O_Dnode;
         Off : O_Dnode;
         Bound : O_Enode;
         Cond1, Cond2: O_Enode;
         Index_Node : O_Dnode;
         Bound_Node : O_Dnode;
         Index_Info : Type_Info_Acc;
         Deep_Rng : Iir;
         Deep_Reverse : Boolean;
      begin
         Index_Info := Get_Info (Get_Base_Type (Range_Type));
         if Index_Expr = Null_Iir then
            Need_Check := True;
            Deep_Rng := Null_Iir;
            Deep_Reverse := False;
         else
            Need_Check := Need_Index_Check (Get_Type (Index_Expr), Range_Type);
            Get_Deep_Range_Expression (Range_Type, Deep_Rng, Deep_Reverse);
         end if;

         Res := Create_Temp (Ghdl_Index_Type);

         Open_Temp;

         Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value));

         Bound := M2E (Chap3.Range_To_Left (Rng));

         if Deep_Rng /= Null_Iir then
            if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then
               --  Direction TO:  INDEX - LEFT.
               New_Assign_Stmt (New_Obj (Off),
                                New_Dyadic_Op (ON_Sub_Ov,
                                               Index, Bound));
            else
               --  Direction DOWNTO: LEFT - INDEX.
               New_Assign_Stmt (New_Obj (Off),
                                New_Dyadic_Op (ON_Sub_Ov,
                                               Bound, Index));
            end if;
         else
            Index_Node := Create_Temp_Init
              (Index_Info.Ortho_Type (Mode_Value), Index);
            Bound_Node := Create_Temp_Init
              (Index_Info.Ortho_Type (Mode_Value), Bound);
            Dir := M2E (Chap3.Range_To_Dir (Rng));

            --  Non-static direction.
            Start_If_Stmt (If_Blk,
                           New_Compare_Op (ON_Eq, Dir,
                                           New_Lit (Ghdl_Dir_To_Node),
                                           Ghdl_Bool_Type));
            --  Direction TO:  INDEX - LEFT.
            New_Assign_Stmt (New_Obj (Off),
                             New_Dyadic_Op (ON_Sub_Ov,
                                            New_Obj_Value (Index_Node),
                                            New_Obj_Value (Bound_Node)));
            New_Else_Stmt (If_Blk);
            --  Direction DOWNTO: LEFT - INDEX.
            New_Assign_Stmt (New_Obj (Off),
                             New_Dyadic_Op (ON_Sub_Ov,
                                            New_Obj_Value (Bound_Node),
                                            New_Obj_Value (Index_Node)));
            Finish_If_Stmt (If_Blk);
         end if;

         --  Get the offset.
         New_Assign_Stmt
           (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off),
                                           Ghdl_Index_Type));

         --  Check bounds.
         if Need_Check then
            Cond1 := New_Compare_Op
              (ON_Lt,
               New_Obj_Value (Off),
               New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
                                            0)),
               Ghdl_Bool_Type);

            Cond2 := New_Compare_Op
              (ON_Ge,
               New_Obj_Value (Res),
               M2E (Chap3.Range_To_Length (Rng)),
               Ghdl_Bool_Type);
            Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0);
         end if;

         Close_Temp;

         return New_Obj_Value (Res);
      end Translate_Index_To_Offset;

      --  Translate index EXPR in dimension DIM of thin array into an
      --  offset.
      --  This checks bounds.
      function Translate_Thin_Index_Offset (Index_Type : Iir;
                                            Dim : Natural;
                                            Expr : Iir)
        return O_Enode
      is
         Index_Range : constant Iir := Get_Range_Constraint (Index_Type);
         Obound : O_Cnode;
         Res : O_Dnode;
         Cond2: O_Enode;
         Index : O_Enode;
         Index_Base_Type : Iir;
         V : Iir_Int64;
         B : Iir_Int64;
      begin
         B := Eval_Pos (Get_Left_Limit (Index_Range));
         if Get_Expr_Staticness (Expr) = Locally then
            V := Eval_Pos (Eval_Static_Expr (Expr));
            if Get_Direction (Index_Range) = Iir_To then
               B := V - B;
            else
               B := B - V;
            end if;
            return New_Lit
              (New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (B)));
         else
            Index_Base_Type := Get_Base_Type (Index_Type);
            Index := Chap7.Translate_Expression (Expr, Index_Base_Type);

            if Get_Direction (Index_Range) = Iir_To then
               --  Direction TO:  INDEX - LEFT.
               if B /= 0 then
                  Obound := Chap7.Translate_Static_Range_Left
                    (Index_Range, Index_Base_Type);
                  Index := New_Dyadic_Op (ON_Sub_Ov, Index, New_Lit (Obound));
               end if;
            else
               --  Direction DOWNTO:  LEFT - INDEX.
               Obound := Chap7.Translate_Static_Range_Left
                 (Index_Range, Index_Base_Type);
               Index := New_Dyadic_Op (ON_Sub_Ov, New_Lit (Obound), Index);
            end if;

            --  Get the offset.
            Index := New_Convert_Ov (Index, Ghdl_Index_Type);

            --  Since the value is unsigned, both left and right bounds are
            --  checked in the same time.
            if Get_Type (Expr) /= Index_Type then
               Res := Create_Temp_Init (Ghdl_Index_Type, Index);

               Cond2 := New_Compare_Op
                 (ON_Ge, New_Obj_Value (Res),
                  New_Lit (Chap7.Translate_Static_Range_Length (Index_Range)),
                  Ghdl_Bool_Type);
               Check_Bound_Error (Cond2, Expr, Dim);
               Index := New_Obj_Value (Res);
            end if;

            return Index;
         end if;
      end Translate_Thin_Index_Offset;

      --  Translate an indexed name.
      type Indexed_Name_Data is record
         Offset : O_Dnode;
         Res : Mnode;
      end record;

      function Translate_Indexed_Name_Init (Prefix_Orig : Mnode; Expr : Iir)
                                           return Indexed_Name_Data
      is
         Prefix : Mnode;
         Prefix_Type : Iir;
         Index : Iir;
         Index_List : Iir_List;
         Type_List : Iir_List;
         Offset : O_Dnode;
         R : O_Enode;
         Length : O_Enode;
         Itype : Iir;
         Ibasetype : Iir;
         Prefix_Info : Type_Info_Acc;
         Nbr_Dim : Natural;
         Range_Ptr : Mnode;
      begin
         Prefix_Type := Get_Type (Get_Prefix (Expr));
         Prefix_Info := Get_Info (Prefix_Type);
         case Prefix_Info.Type_Mode is
            when Type_Mode_Fat_Array =>
               Prefix := Stabilize (Prefix_Orig);
            when Type_Mode_Array =>
               Prefix := Prefix_Orig;
            when others =>
               raise Internal_Error;
         end case;
         Index_List := Get_Index_List (Expr);
         Type_List := Get_Index_Subtype_List (Prefix_Type);
         Nbr_Dim := Get_Nbr_Elements (Index_List);
         Offset := Create_Temp (Ghdl_Index_Type);
         for Dim in 1 .. Nbr_Dim loop
            Index := Get_Nth_Element (Index_List, Dim - 1);
            Itype := Get_Index_Type (Type_List, Dim - 1);
            Ibasetype := Get_Base_Type (Itype);
            Open_Temp;
            --  Compute index for the current dimension.
            case Prefix_Info.Type_Mode is
               when Type_Mode_Fat_Array =>
                  Range_Ptr := Stabilize
                    (Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim));
                  R := Translate_Index_To_Offset
                    (Range_Ptr,
                     Chap7.Translate_Expression (Index, Ibasetype),
                     Null_Iir, Itype, Index);
               when Type_Mode_Array =>
                  if Prefix_Info.Type_Locally_Constrained then
                     R := Translate_Thin_Index_Offset (Itype, Dim, Index);
                  else
                     --  Manually extract range since there is no infos for
                     --   index subtype.
                     Range_Ptr := Chap3.Bounds_To_Range
                       (Chap3.Get_Array_Type_Bounds (Prefix_Type),
                        Prefix_Type, Dim);
                     Stabilize (Range_Ptr);
                     R := Translate_Index_To_Offset
                       (Range_Ptr,
                        Chap7.Translate_Expression (Index, Ibasetype),
                        Index, Itype, Index);
                  end if;
               when others =>
                  raise Internal_Error;
            end case;
            if Dim = 1 then
               --  First dimension.
               New_Assign_Stmt (New_Obj (Offset), R);
            else
               --  If there are more dimension(s) to follow, then multiply
               --  the current offset by the length of the current dimension.
               if Prefix_Info.Type_Locally_Constrained then
                  Length := New_Lit (Chap7.Translate_Static_Range_Length
                                       (Get_Range_Constraint (Itype)));
               else
                  Length := M2E (Chap3.Range_To_Length (Range_Ptr));
               end if;
               New_Assign_Stmt
                 (New_Obj (Offset),
                  New_Dyadic_Op (ON_Add_Ov,
                                 New_Dyadic_Op (ON_Mul_Ov,
                                                New_Obj_Value (Offset),
                                                Length),
                                 R));
            end if;
            Close_Temp;
         end loop;

         return (Offset => Offset,
                 Res => Chap3.Index_Base
                   (Chap3.Get_Array_Base (Prefix), Prefix_Type,
                    New_Obj_Value (Offset)));
      end Translate_Indexed_Name_Init;

      function Translate_Indexed_Name_Finish
        (Prefix : Mnode; Expr : Iir; Data : Indexed_Name_Data)
        return Mnode
      is
      begin
         return Chap3.Index_Base (Chap3.Get_Array_Base (Prefix),
                                  Get_Type (Get_Prefix (Expr)),
                                  New_Obj_Value (Data.Offset));
      end Translate_Indexed_Name_Finish;

      function Translate_Indexed_Name (Prefix : Mnode; Expr : Iir)
                                      return Mnode
      is
      begin
         return Translate_Indexed_Name_Init (Prefix, Expr).Res;
      end Translate_Indexed_Name;

      type Slice_Name_Data is record
         Off : Unsigned_64;
         Is_Off : Boolean;

         Unsigned_Diff : O_Dnode;

         --  Variable pointing to the prefix.
         Prefix_Var : Mnode;

         --  Variable pointing to slice.
         Slice_Range : Mnode;
      end record;

      procedure Translate_Slice_Name_Init
        (Prefix : Mnode; Expr : Iir_Slice_Name; Data : out Slice_Name_Data)
      is
         --  Type of the prefix.
         Prefix_Type : Iir;

         --  Type info of the prefix.
         Prefix_Info : Type_Info_Acc;

         --  Type of the slice.
         Slice_Type : Iir;
         Slice_Info : Type_Info_Acc;

         --  Type of the first (and only) index of the prefix array type.
         Index_Type : Iir;

         --  True iff the direction of the slice is known at compile time.
         Static_Range : Boolean;

         --  Suffix of the slice (discrete range).
         Expr_Range : Iir;

         --  Variable pointing to the prefix.
         Prefix_Var : Mnode;

         --  Type info of the range base type.
         Index_Info : Type_Info_Acc;

         --  Variables pointing to slice and prefix ranges.
         Slice_Range : Mnode;
         Prefix_Range : Mnode;

         Diff : O_Dnode;
         Unsigned_Diff : O_Dnode;
         If_Blk1 : O_If_Block;
      begin
         --  Evaluate the prefix.
         Slice_Type := Get_Type (Expr);
         Expr_Range := Get_Suffix (Expr);
         Prefix_Type := Get_Type (Get_Prefix (Expr));
         Index_Type := Get_Index_Type (Prefix_Type, 0);

         --  Evaluate slice bounds.
         Chap3.Create_Array_Subtype (Slice_Type, True);

         Prefix_Info := Get_Info (Prefix_Type);
         Slice_Info := Get_Info (Slice_Type);

         if Slice_Info.Type_Mode = Type_Mode_Array
           and then Slice_Info.Type_Locally_Constrained
           and then Prefix_Info.Type_Mode = Type_Mode_Array
           and then Prefix_Info.Type_Locally_Constrained
         then
            Data.Is_Off := True;
            Data.Prefix_Var := Prefix;

            --  Both prefix and result are constrained array.
            declare
               Prefix_Left, Slice_Left : Iir_Int64;
               Off : Iir_Int64;
               Slice_Index_Type : Iir;
               Slice_Range : Iir;
               Slice_Length : Iir_Int64;
               Index_Range : Iir;
            begin
               Index_Range := Get_Range_Constraint (Index_Type);
               Prefix_Left := Eval_Pos (Get_Left_Limit (Index_Range));
               Slice_Index_Type := Get_Index_Type (Slice_Type, 0);
               Slice_Range := Get_Range_Constraint (Slice_Index_Type);
               Slice_Left := Eval_Pos (Get_Left_Limit (Slice_Range));
               Slice_Length := Eval_Discrete_Range_Length (Slice_Range);
               if Slice_Length = 0 then
                  --  Null slice.
                  Data.Off := 0;
                  return;
               end if;
               if Get_Direction (Index_Range) /= Get_Direction (Slice_Range)
               then
                  --  This is allowed with vhdl87
                  Off := 0;
                  Slice_Length := 0;
               else
                  --  Both prefix and slice are thin array.
                  case Get_Direction (Index_Range) is
                     when Iir_To =>
                        Off := Slice_Left - Prefix_Left;
                     when Iir_Downto =>
                        Off := Prefix_Left - Slice_Left;
                  end case;
                  if Off < 0 then
                     --  Must have been caught by sem.
                     raise Internal_Error;
                  end if;
                  if Off + Slice_Length
                    > Eval_Discrete_Range_Length (Index_Range)
                  then
                     --  Must have been caught by sem.
                     raise Internal_Error;
                  end if;
               end if;
               Data.Off := Unsigned_64 (Off);

               return;
            end;
         end if;

         Data.Is_Off := False;

         --  Save prefix.
         Prefix_Var := Stabilize (Prefix);

         Index_Info := Get_Info (Get_Base_Type (Index_Type));

         --  Save prefix bounds.
         Prefix_Range := Stabilize
           (Chap3.Get_Array_Range (Prefix_Var, Prefix_Type, 1));

         --  Save slice bounds.
         Slice_Range := Stabilize
           (Chap3.Bounds_To_Range (Chap3.Get_Array_Type_Bounds (Slice_Type),
                                   Slice_Type, 1));

         --  TRUE if the direction of the slice is known.
         Static_Range := Get_Kind (Expr_Range) = Iir_Kind_Range_Expression;

         --  Check direction against same direction, error if different.
         --  FIXME: what about v87 -> if different then null slice
         if not Static_Range
           or else Get_Kind (Prefix_Type) /= Iir_Kind_Array_Subtype_Definition
         then
            --  Check same direction.
            Check_Bound_Error
              (New_Compare_Op (ON_Neq,
                               M2E (Chap3.Range_To_Dir (Prefix_Range)),
                               M2E (Chap3.Range_To_Dir (Slice_Range)),
                               Ghdl_Bool_Type),
               Expr, 1);
         end if;

         --  Check if not a null slice.
         --  FIXME: why ?
         --Start_If_Stmt
         --  (If_Blk,
         --   New_Compare_Op
         --   (ON_Neq,
         --    Get_Array_Bound_Length (Res, Prefix_Type, 1, Sig),
         --    New_Unsigned_Literal (Ghdl_Index_Type, 0),
         --    Ghdl_Bool_Type_Node));

         Diff := Create_Temp (Index_Info.Ortho_Type (Mode_Value));

         --  Compute the offset in the prefix.
         if not Static_Range then
            Start_If_Stmt
              (If_Blk1, New_Compare_Op (ON_Eq,
                                        M2E (Chap3.Range_To_Dir (Slice_Range)),
                                        New_Lit (Ghdl_Dir_To_Node),
                                        Ghdl_Bool_Type));
         end if;
         if not Static_Range or else Get_Direction (Expr_Range) = Iir_To then
            --  Diff = slice - bounds.
            New_Assign_Stmt
              (New_Obj (Diff),
               New_Dyadic_Op (ON_Sub_Ov,
                              M2E (Chap3.Range_To_Left (Slice_Range)),
                              M2E (Chap3.Range_To_Left (Prefix_Range))));
         end if;
         if not Static_Range then
            New_Else_Stmt (If_Blk1);
         end if;
         if not Static_Range or else Get_Direction (Expr_Range) = Iir_Downto
         then
            --  Diff = bounds - slice.
            New_Assign_Stmt
              (New_Obj (Diff),
               New_Dyadic_Op (ON_Sub_Ov,
                              M2E (Chap3.Range_To_Left (Prefix_Range)),
                              M2E (Chap3.Range_To_Left (Slice_Range))));
         end if;
         if not Static_Range then
            Finish_If_Stmt (If_Blk1);
         end if;

         --  Note: this also check for overflow.
         Unsigned_Diff := Create_Temp (Ghdl_Index_Type);
         New_Assign_Stmt
           (New_Obj (Unsigned_Diff),
            New_Convert_Ov (New_Obj_Value (Diff), Ghdl_Index_Type));

         --  Check bounds.
         declare
            Err_1 : O_Enode;
            Err_2 : O_Enode;
         begin
            --  Bounds error if left of slice is before left of prefix.
            Err_1 := New_Compare_Op
              (ON_Lt,
               New_Obj_Value (Diff),
               New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value),
                                            0)),
               Ghdl_Bool_Type);
            --  Bounds error if right of slice is after right of prefix.
            Err_2 := New_Compare_Op
              (ON_Gt,
               New_Dyadic_Op (ON_Add_Ov,
                              New_Obj_Value (Unsigned_Diff),
                              M2E (Chap3.Range_To_Length (Slice_Range))),
               M2E (Chap3.Range_To_Length (Prefix_Range)),
               Ghdl_Bool_Type);
            Check_Bound_Error (New_Dyadic_Op (ON_Or, Err_1, Err_2), Expr, 1);
         end;

         Data.Slice_Range := Slice_Range;
         Data.Prefix_Var := Prefix_Var;
         Data.Unsigned_Diff := Unsigned_Diff;
         Data.Is_Off := False;
      end Translate_Slice_Name_Init;

      function Translate_Slice_Name_Finish
        (Prefix : Mnode; Expr : Iir_Slice_Name; Data : Slice_Name_Data)
        return Mnode
      is
         --  Type of the slice.
         Slice_Type : constant Iir := Get_Type (Expr);
         Slice_Info : constant Type_Info_Acc := Get_Info (Slice_Type);

         --  Object kind of the prefix.
         Kind : constant Object_Kind_Type := Get_Object_Kind (Prefix);

         Res_D : O_Dnode;
      begin
         if Data.Is_Off then
            return Chap3.Slice_Base
              (Prefix, Slice_Type, New_Lit (New_Unsigned_Literal
                                              (Ghdl_Index_Type, Data.Off)));
         else
            --  Create the result (fat array) and assign the bounds field.
            case Slice_Info.Type_Mode is
               when Type_Mode_Fat_Array =>
                  Res_D := Create_Temp (Slice_Info.Ortho_Type (Kind));
                  New_Assign_Stmt
                    (New_Selected_Element (New_Obj (Res_D),
                                           Slice_Info.T.Bounds_Field (Kind)),
                     New_Value (M2Lp (Data.Slice_Range)));
                  New_Assign_Stmt
                    (New_Selected_Element (New_Obj (Res_D),
                                           Slice_Info.T.Base_Field (Kind)),
                     M2E (Chap3.Slice_Base
                            (Chap3.Get_Array_Base (Prefix),
                             Slice_Type,
                             New_Obj_Value (Data.Unsigned_Diff))));
                  return Dv2M (Res_D, Slice_Info, Kind);
               when Type_Mode_Array =>
                  return Chap3.Slice_Base
                    (Chap3.Get_Array_Base (Prefix),
                     Slice_Type,
                     New_Obj_Value (Data.Unsigned_Diff));
               when others =>
                  raise Internal_Error;
            end case;
         end if;
      end Translate_Slice_Name_Finish;

      function Translate_Slice_Name
        (Prefix : Mnode; Expr : Iir_Slice_Name)
        return Mnode
      is
         Data : Slice_Name_Data;
      begin
         Translate_Slice_Name_Init (Prefix, Expr, Data);
         return Translate_Slice_Name_Finish (Data.Prefix_Var, Expr, Data);
      end Translate_Slice_Name;

      function Translate_Interface_Name
        (Inter : Iir; Info : Ortho_Info_Acc; Kind : Object_Kind_Type)
        return Mnode
      is
         Type_Info : constant Type_Info_Acc := Get_Info (Get_Type (Inter));
      begin
         case Info.Kind is
            when Kind_Object =>
               --  For a generic or a port.
               return Get_Var (Info.Object_Var, Type_Info, Kind);
            when Kind_Interface =>
               --  For a parameter.
               if Info.Interface_Field /= O_Fnode_Null then
                  declare
                     Subprg_Info : constant Subprg_Info_Acc :=
                       Get_Info (Get_Parent (Inter));
                     Linter : O_Lnode;
                  begin
                     if Info.Interface_Node = O_Dnode_Null then
                        --  Passed by copy in the RESULT record.
                        return Lv2M
                          (New_Selected_Element
                             (Get_Instance_Ref (Subprg_Info.Res_Record_Type),
                              Info.Interface_Field),
                           Type_Info, Kind);
                     else
                        --  Use field in FRAME (instead of direct reference
                        --  to parameter - used to unnest subprograms).
                        Linter :=
                          New_Selected_Element
                          (Get_Instance_Ref (Subprg_Info.Subprg_Frame_Type),
                           Info.Interface_Field);
                        case Type_Info.Type_Mode is
                           when Type_Mode_Unknown =>
                              raise Internal_Error;
                           when Type_Mode_By_Value =>
                              return Lv2M (Linter, Type_Info, Kind);
                           when Type_Mode_By_Copy
                             | Type_Mode_By_Ref =>
                              --  Parameter is passed by reference.
                              return Lp2M (Linter, Type_Info, Kind);
                        end case;
                     end if;
                  end;
               else
                  case Type_Info.Type_Mode is
                     when Type_Mode_Unknown =>
                        raise Internal_Error;
                     when Type_Mode_By_Value =>
                        return Dv2M (Info.Interface_Node, Type_Info, Kind);
                     when Type_Mode_By_Copy
                       | Type_Mode_By_Ref =>
                        --  Parameter is passed by reference.
                        return Dp2M (Info.Interface_Node, Type_Info, Kind);
                  end case;
               end if;
            when others =>
               raise Internal_Error;
         end case;
      end Translate_Interface_Name;

      function Translate_Selected_Element (Prefix : Mnode;
                                           El : Iir_Element_Declaration)
        return Mnode
      is
         El_Info : constant Field_Info_Acc := Get_Info (El);
         El_Type : constant Iir := Get_Type (El);
         El_Tinfo : constant Type_Info_Acc := Get_Info (El_Type);
         Kind : constant Object_Kind_Type := Get_Object_Kind (Prefix);
         Stable_Prefix : Mnode;
      begin
         if Is_Complex_Type (El_Tinfo) then
            --  The element is in fact an offset.
            Stable_Prefix := Stabilize (Prefix);
            return E2M
              (New_Unchecked_Address
                 (New_Slice
                    (New_Access_Element
                       (New_Unchecked_Address
                          (M2Lv (Stable_Prefix), Char_Ptr_Type)),
                     Chararray_Type,
                     New_Value
                       (New_Selected_Element (M2Lv (Stable_Prefix),
                                              El_Info.Field_Node (Kind)))),
                  El_Tinfo.Ortho_Ptr_Type (Kind)),
               El_Tinfo, Kind);
         else
            return Lv2M (New_Selected_Element (M2Lv (Prefix),
                                               El_Info.Field_Node (Kind)),
                         El_Tinfo, Kind);
         end if;
      end Translate_Selected_Element;

--       function Translate_Formal_Interface_Name (Scope_Type : O_Tnode;
--                                                 Scope_Param : O_Lnode;
--                                                 Name : Iir;
--                                                 Kind : Object_Kind_Type)
--                                                return Mnode
--       is
--          Type_Info : Type_Info_Acc;
--          Info : Ortho_Info_Acc;
--          Res : Mnode;
--       begin
--          Type_Info := Get_Info (Get_Type (Name));
--          Info := Get_Info (Name);
--          Push_Scope_Soft (Scope_Type, Scope_Param);
--          Res := Get_Var (Info.Object_Var, Type_Info, Kind);
--          Pop_Scope_Soft (Scope_Type);
--          return Res;
--       end Translate_Formal_Interface_Name;

--       function Translate_Formal_Name (Scope_Type : O_Tnode;
--                                       Scope_Param : O_Lnode;
--                                       Name : Iir)
--                                      return Mnode
--       is
--          Prefix : Iir;
--          Prefix_Name : Mnode;
--       begin
--          case Get_Kind (Name) is
--             when Iir_Kind_Constant_Interface_Declaration =>
--                return Translate_Formal_Interface_Name
--                  (Scope_Type, Scope_Param, Name, Mode_Value);

--             when Iir_Kind_Signal_Interface_Declaration =>
--                return Translate_Formal_Interface_Name
--                  (Scope_Type, Scope_Param, Name, Mode_Signal);

--             when Iir_Kind_Indexed_Name =>
--                Prefix := Get_Prefix (Name);
--                Prefix_Name := Translate_Formal_Name
--                  (Scope_Type, Scope_Param, Prefix);
--                return Translate_Indexed_Name (Prefix_Name, Name);

--             when Iir_Kind_Slice_Name =>
--                Prefix := Get_Prefix (Name);
--                Prefix_Name := Translate_Formal_Name
--                  (Scope_Type, Scope_Param, Prefix);
--                return Translate_Slice_Name (Prefix_Name, Name);

--             when Iir_Kind_Selected_Element =>
--                Prefix := Get_Prefix (Name);
--                Prefix_Name := Translate_Formal_Name
--                  (Scope_Type, Scope_Param, Prefix);
--                return Translate_Selected_Element
--                  (Prefix_Name, Get_Selected_Element (Name));

--             when others =>
--                Error_Kind ("translate_generic_name", Name);
--          end case;
--       end Translate_Formal_Name;

      function Translate_Name (Name : Iir) return Mnode
      is
         Name_Type : constant Iir := Get_Type (Name);
         Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
         Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
      begin
         case Get_Kind (Name) is
            when Iir_Kind_Constant_Declaration
              | Iir_Kind_Variable_Declaration
              | Iir_Kind_File_Declaration =>
               return Get_Var (Name_Info.Object_Var, Type_Info, Mode_Value);

            when Iir_Kind_Attribute_Name =>
               return Translate_Name (Get_Named_Entity (Name));
            when Iir_Kind_Attribute_Value =>
               return Get_Var
                 (Get_Info (Get_Attribute_Specification (Name)).Object_Var,
                  Type_Info, Mode_Value);

            when Iir_Kind_Object_Alias_Declaration =>
               --  Alias_Var is not like an object variable, since it is
               --  always a pointer to the aliased object.
               declare
                  R : O_Lnode;
               begin
                  R := Get_Var (Name_Info.Alias_Var);
                  case Type_Info.Type_Mode is
                     when Type_Mode_Fat_Array =>
                        return Get_Var (Name_Info.Alias_Var, Type_Info,
                                        Name_Info.Alias_Kind);
                     when Type_Mode_Array
                       | Type_Mode_Record
                       | Type_Mode_Acc
                       | Type_Mode_Fat_Acc =>
                        R := Get_Var (Name_Info.Alias_Var);
                        return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
                     when Type_Mode_Scalar =>
                        R := Get_Var (Name_Info.Alias_Var);
                        if Name_Info.Alias_Kind = Mode_Signal then
                           return Lv2M (R, Type_Info, Name_Info.Alias_Kind);
                        else
                           return Lp2M (R, Type_Info, Name_Info.Alias_Kind);
                        end if;
                     when others =>
                        raise Internal_Error;
                  end case;
               end;

            when Iir_Kind_Signal_Declaration
              | Iir_Kind_Stable_Attribute
              | Iir_Kind_Quiet_Attribute
              | Iir_Kind_Delayed_Attribute
              | Iir_Kind_Transaction_Attribute
              | Iir_Kind_Guard_Signal_Declaration =>
               return Get_Var (Name_Info.Object_Var, Type_Info, Mode_Signal);

            when Iir_Kind_Constant_Interface_Declaration =>
               return Translate_Interface_Name (Name, Name_Info, Mode_Value);

            when Iir_Kind_File_Interface_Declaration =>
               return Translate_Interface_Name (Name, Name_Info, Mode_Value);

            when Iir_Kind_Variable_Interface_Declaration =>
               return Translate_Interface_Name (Name, Name_Info, Mode_Value);

            when Iir_Kind_Signal_Interface_Declaration =>
               return Translate_Interface_Name (Name, Name_Info, Mode_Signal);

            when Iir_Kind_Indexed_Name =>
               return Translate_Indexed_Name
                 (Translate_Name (Get_Prefix (Name)), Name);

            when Iir_Kind_Slice_Name =>
               return Translate_Slice_Name
                 (Translate_Name (Get_Prefix (Name)), Name);

            when Iir_Kind_Dereference
              | Iir_Kind_Implicit_Dereference =>
               declare
                  Pfx : O_Enode;
               begin
                  Pfx := Chap7.Translate_Expression (Get_Prefix (Name));
                  --  FIXME: what about fat pointer ??
                  return Lv2M (New_Access_Element (Pfx),
                               Type_Info, Mode_Value);
               end;

            when Iir_Kind_Selected_Element =>
               return Translate_Selected_Element
                 (Translate_Name (Get_Prefix (Name)),
                  Get_Selected_Element (Name));

            when Iir_Kind_Function_Call =>
               --  This can appear as a prefix of a name, therefore, the
               --  result is always a composite type or an access type.
               declare
                  Imp : constant Iir :=
                    Get_Named_Entity (Get_Implementation (Name));
                  Obj : Iir;
                  Assoc_Chain : Iir;
               begin
                  if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration
                  then
                     --  FIXME : to be done
                     raise Internal_Error;
                  else
                     Canon.Canon_Subprogram_Call (Name);
                     Assoc_Chain := Get_Parameter_Association_Chain (Name);
                     Obj := Get_Method_Object (Name);
                     return E2M
                       (Chap7.Translate_Function_Call (Imp, Assoc_Chain, Obj),
                        Type_Info, Mode_Value);
                  end if;
               end;

            when Iir_Kind_Image_Attribute =>
               --  Can appear as a prefix.
               return E2M (Chap14.Translate_Image_Attribute (Name),
                           Type_Info, Mode_Value);

            when Iir_Kind_Simple_Name
              | Iir_Kind_Selected_Name =>
               return Translate_Name (Get_Named_Entity (Name));

            when others =>
               Error_Kind ("translate_name", Name);
         end case;
      end Translate_Name;

      procedure Translate_Direct_Driver
        (Name : Iir; Sig : out Mnode; Drv : out Mnode)
      is
         Name_Type : constant Iir := Get_Type (Name);
         Name_Info : constant Ortho_Info_Acc := Get_Info (Name);
         Type_Info : constant Type_Info_Acc := Get_Info (Name_Type);
      begin
         case Get_Kind (Name) is
            when Iir_Kind_Simple_Name
              | Iir_Kind_Selected_Name =>
               Translate_Direct_Driver (Get_Named_Entity (Name), Sig, Drv);
            when Iir_Kind_Object_Alias_Declaration =>
               Translate_Direct_Driver (Get_Name (Name), Sig, Drv);
            when Iir_Kind_Signal_Declaration
              | Iir_Kind_Signal_Interface_Declaration =>
               Sig := Get_Var (Name_Info.Object_Var, Type_Info, Mode_Signal);
               Drv := Get_Var (Name_Info.Object_Driver, Type_Info, Mode_Value);
            when Iir_Kind_Slice_Name =>
               declare
                  Data : Slice_Name_Data;
                  Pfx_Sig : Mnode;
                  Pfx_Drv : Mnode;
               begin
                  Translate_Direct_Driver
                    (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
                  Translate_Slice_Name_Init (Pfx_Sig, Name, Data);
                  Sig := Translate_Slice_Name_Finish
                    (Data.Prefix_Var, Name, Data);
                  Drv := Translate_Slice_Name_Finish (Pfx_Drv, Name, Data);
               end;
            when Iir_Kind_Indexed_Name =>
               declare
                  Data : Indexed_Name_Data;
                  Pfx_Sig : Mnode;
                  Pfx_Drv : Mnode;
               begin
                  Translate_Direct_Driver
                    (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
                  Data := Translate_Indexed_Name_Init (Pfx_Sig, Name);
                  Sig := Data.Res;
                  Drv := Translate_Indexed_Name_Finish (Pfx_Drv, Name, Data);
               end;
            when Iir_Kind_Selected_Element =>
               declare
                  El : Iir;
                  Pfx_Sig : Mnode;
                  Pfx_Drv : Mnode;
               begin
                  Translate_Direct_Driver
                    (Get_Prefix (Name), Pfx_Sig, Pfx_Drv);
                  El := Get_Selected_Element (Name);
                  Sig := Translate_Selected_Element (Pfx_Sig, El);
                  Drv := Translate_Selected_Element (Pfx_Drv, El);
               end;
            when others =>
               Error_Kind ("translate_direct_driver", Name);
         end case;
      end Translate_Direct_Driver;
   end Chap6;

   package body Chap7 is
      function Is_Static_Constant (Decl : Iir_Constant_Declaration)
                                  return Boolean
      is
         Expr : constant Iir := Get_Default_Value (Decl);
         Atype : Iir;
         Info : Iir;
      begin
         if Expr = Null_Iir
           or else Get_Kind (Expr) = Iir_Kind_Overflow_Literal
         then
            --  Deferred constant.
            return False;
         end if;

         if Get_Expr_Staticness (Decl) = Locally then
            return True;
         end if;

         --  Only aggregates are handled.
         if Get_Kind (Expr) /= Iir_Kind_Aggregate then
            return False;
         end if;

         Atype := Get_Type (Decl);
         --  Bounds must be known (and static).
         if Get_Type_Staticness (Atype) /= Locally then
            return False;
         end if;

         --  Currently, only array aggregates are handled.
         if Get_Kind (Get_Base_Type (Atype)) /= Iir_Kind_Array_Type_Definition
         then
            return False;
         end if;

         --  Aggregate elements must be locally static.
         --  Note: this does not yet handled aggregates of aggregates.
         if Get_Value_Staticness (Expr) /= Locally then
            return False;
         end if;
         Info := Get_Aggregate_Info (Expr);
         while Info /= Null_Iir loop
            if Get_Aggr_Dynamic_Flag (Info) then
               raise Internal_Error;
            end if;

            --  Currently, only positionnal aggregates are handled.
            if Get_Aggr_Named_Flag (Info) then
               return False;
            end if;
            --  Currently, others choice are not handled.
            if Get_Aggr_Others_Flag (Info) then
               return False;
            end if;

            Info := Get_Sub_Aggregate_Info (Info);
         end loop;
         return True;
      end Is_Static_Constant;

      procedure Translate_Static_String_Literal_Inner
        (List : in out O_Array_Aggr_List;
         Str : Iir;
         El_Type : Iir)
      is
         use Name_Table;

         Literal_List : Iir_List;
         Lit : Iir;
         Len : Nat32;
         Ptr : String_Fat_Acc;
      begin
         Literal_List :=
           Get_Enumeration_Literal_List (Get_Base_Type (El_Type));
         Len := Get_String_Length (Str);
         Ptr := Get_String_Fat_Acc (Str);
         for I in 1 .. Len loop
            Lit := Find_Name_In_List (Literal_List, Get_Identifier (Ptr (I)));
            New_Array_Aggr_El (List, Get_Ortho_Expr (Lit));
         end loop;
      end Translate_Static_String_Literal_Inner;

      procedure Translate_Static_Bit_String_Literal_Inner
        (List : in out O_Array_Aggr_List;
         Lit : Iir_Bit_String_Literal;
         El_Type : Iir)
      is
         pragma Unreferenced (El_Type);
         L_0 : O_Cnode;
         L_1 : O_Cnode;
         Ptr : String_Fat_Acc;
         Len : Nat32;
         V : O_Cnode;
      begin
         L_0 := Get_Ortho_Expr (Get_Bit_String_0 (Lit));
         L_1 := Get_Ortho_Expr (Get_Bit_String_1 (Lit));
         Ptr := Get_String_Fat_Acc (Lit);
         Len := Get_String_Length (Lit);
         for I in 1 .. Len loop
            case Ptr (I) is
               when '0' =>
                  V := L_0;
               when '1' =>
                  V := L_1;
               when others =>
                  raise Internal_Error;
            end case;
            New_Array_Aggr_El (List, V);
         end loop;
      end Translate_Static_Bit_String_Literal_Inner;

      procedure Translate_Static_Aggregate_1 (List : in out O_Array_Aggr_List;
                                              Aggr : Iir;
                                              Info : Iir;
                                              El_Type : Iir)
      is
         Assoc : Iir;
         N_Info : Iir;
         Sub : Iir;
      begin
         N_Info := Get_Sub_Aggregate_Info (Info);

         case Get_Kind (Aggr) is
            when Iir_Kind_Aggregate =>
               Assoc := Get_Association_Choices_Chain (Aggr);
               while Assoc /= Null_Iir loop
                  Sub := Get_Associated (Assoc);
                  case Get_Kind (Assoc) is
                     when Iir_Kind_Choice_By_None =>
                        if N_Info = Null_Iir then
                           New_Array_Aggr_El
                             (List,
                              Translate_Static_Expression (Sub, El_Type));
                        else
                           Translate_Static_Aggregate_1
                             (List, Sub, N_Info, El_Type);
                        end if;
                     when others =>
                        Error_Kind ("translate_static_aggregate_1(2)", Assoc);
                  end case;
                  Assoc := Get_Chain (Assoc);
               end loop;
            when Iir_Kind_String_Literal =>
               if N_Info /= Null_Iir then
                  raise Internal_Error;
               end if;
               Translate_Static_String_Literal_Inner (List, Aggr, El_Type);
            when Iir_Kind_Bit_String_Literal =>
               if N_Info /= Null_Iir then
                  raise Internal_Error;
               end if;
               Translate_Static_Bit_String_Literal_Inner (List, Aggr, El_Type);
            when others =>
               Error_Kind ("translate_static_aggregate_1", Aggr);
         end case;
      end Translate_Static_Aggregate_1;

      function Translate_Static_Aggregate (Aggr : Iir)
                                          return O_Cnode
      is
         Aggr_Type : Iir;
         El_Type : Iir;
         List : O_Array_Aggr_List;
         Res : O_Cnode;
      begin
         Aggr_Type := Get_Type (Aggr);
         Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True);
         El_Type := Get_Element_Subtype (Aggr_Type);
         Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));

         Translate_Static_Aggregate_1
           (List, Aggr, Get_Aggregate_Info (Aggr), El_Type);
         Finish_Array_Aggr (List, Res);
         return Res;
      end Translate_Static_Aggregate;

      function Translate_Static_Simple_Aggregate (Aggr : Iir)
        return O_Cnode
      is
         Aggr_Type : Iir;
         El_List : Iir_List;
         El : Iir;
         El_Type : Iir;
         List : O_Array_Aggr_List;
         Res : O_Cnode;
      begin
         Aggr_Type := Get_Type (Aggr);
         Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, True);
         El_Type := Get_Element_Subtype (Aggr_Type);
         El_List := Get_Simple_Aggregate_List (Aggr);
         Start_Array_Aggr (List, Get_Ortho_Type (Aggr_Type, Mode_Value));

         for I in Natural loop
            El := Get_Nth_Element (El_List, I);
            exit when El = Null_Iir;
            New_Array_Aggr_El
              (List, Translate_Static_Expression (El, El_Type));
         end loop;

         Finish_Array_Aggr (List, Res);
         return Res;
      end Translate_Static_Simple_Aggregate;

      function Translate_Static_String_Literal (Str : Iir)
        return O_Cnode
      is
         use Name_Table;

         Lit_Type : Iir;
         Element_Type : Iir;
         Arr_Type : O_Tnode;
         List : O_Array_Aggr_List;
         Res : O_Cnode;
      begin
         Lit_Type := Get_Type (Str);

         Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True);
         Arr_Type := Get_Ortho_Type (Lit_Type, Mode_Value);

         Start_Array_Aggr (List, Arr_Type);

         Element_Type := Get_Element_Subtype (Lit_Type);

         Translate_Static_String_Literal_Inner (List, Str, Element_Type);

         Finish_Array_Aggr (List, Res);
         return Res;
      end Translate_Static_String_Literal;

      --  Create a variable (constant) for string or bit string literal STR.
      --  The type of the literal element is ELEMENT_TYPE, and the ortho type
      --  of the string (a constrained array type) is STR_TYPE.
      function Create_String_Literal_Var_Inner
        (Str : Iir; Element_Type : Iir; Str_Type : O_Tnode)
        return Var_Acc
      is
         use Name_Table;

         Val_Aggr : O_Array_Aggr_List;
         Res : O_Cnode;
      begin
         Start_Array_Aggr (Val_Aggr, Str_Type);
         case Get_Kind (Str) is
            when Iir_Kind_String_Literal =>
               Translate_Static_String_Literal_Inner
                 (Val_Aggr, Str, Element_Type);
            when Iir_Kind_Bit_String_Literal =>
               Translate_Static_Bit_String_Literal_Inner
                 (Val_Aggr, Str, Element_Type);
            when others =>
               raise Internal_Error;
         end case;
         Finish_Array_Aggr (Val_Aggr, Res);

         return Create_Global_Const
           (Create_Uniq_Identifier, Str_Type, O_Storage_Private, Res);
      end Create_String_Literal_Var_Inner;

      --  Create a variable (constant) for string or bit string literal STR.
      function Create_String_Literal_Var (Str : Iir) return Var_Acc is
         use Name_Table;

         Str_Type : constant Iir := Get_Type (Str);
         Arr_Type : O_Tnode;
      begin
         --  Create the string value.
         Arr_Type := New_Constrained_Array_Type
           (Get_Info (Str_Type).T.Base_Type (Mode_Value),
            New_Unsigned_Literal (Ghdl_Index_Type,
                                  Unsigned_64 (Get_String_Length (Str))));

         return Create_String_Literal_Var_Inner
           (Str, Get_Element_Subtype (Str_Type), Arr_Type);
      end Create_String_Literal_Var;

      --  Some strings literal have an unconstrained array type,
      --  eg: 'image of constant.  Its type is not constrained
      --  because it is not so in VHDL!
      function Translate_Non_Static_String_Literal (Str : Iir)
        return O_Enode
      is
         use Name_Table;

         Lit_Type : constant Iir := Get_Type (Str);
         Type_Info : constant Type_Info_Acc := Get_Info (Lit_Type);
         Index_Type : constant Iir := Get_Index_Type (Lit_Type, 0);
         Index_Type_Info : constant Type_Info_Acc := Get_Info (Index_Type);
         Bound_Aggr : O_Record_Aggr_List;
         Index_Aggr : O_Record_Aggr_List;
         Res_Aggr : O_Record_Aggr_List;
         Res : O_Cnode;
         Len : Int32;
         Val : Var_Acc;
         Bound : Var_Acc;
         R : O_Enode;
      begin
         --  Create the string value.
         Len := Get_String_Length (Str);
         Val := Create_String_Literal_Var (Str);

         if Type_Info.Type_Mode = Type_Mode_Fat_Array then
            --  Create the string bound.
            Start_Record_Aggr (Bound_Aggr, Type_Info.T.Bounds_Type);
            Start_Record_Aggr (Index_Aggr, Index_Type_Info.T.Range_Type);
            New_Record_Aggr_El
              (Index_Aggr,
               New_Signed_Literal
                 (Index_Type_Info.Ortho_Type (Mode_Value), 0));
            New_Record_Aggr_El
              (Index_Aggr,
               New_Signed_Literal (Index_Type_Info.Ortho_Type (Mode_Value),
                                Integer_64 (Len - 1)));
            New_Record_Aggr_El
              (Index_Aggr, Ghdl_Dir_To_Node);
            New_Record_Aggr_El
              (Index_Aggr,
               New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Len)));
            Finish_Record_Aggr (Index_Aggr, Res);
            New_Record_Aggr_El (Bound_Aggr, Res);
            Finish_Record_Aggr (Bound_Aggr, Res);
            Bound := Create_Global_Const
              (Create_Uniq_Identifier, Type_Info.T.Bounds_Type,
               O_Storage_Private, Res);

            --  The descriptor.
            Start_Record_Aggr (Res_Aggr, Type_Info.Ortho_Type (Mode_Value));
            New_Record_Aggr_El
              (Res_Aggr,
               New_Global_Address (Get_Var_Label (Val),
                                   Type_Info.T.Base_Ptr_Type (Mode_Value)));
            New_Record_Aggr_El
              (Res_Aggr,
               New_Global_Address (Get_Var_Label (Bound),
                                   Type_Info.T.Bounds_Ptr_Type));
            Finish_Record_Aggr (Res_Aggr, Res);
            Free_Var (Val);
            Free_Var (Bound);

            Val := Create_Global_Const
              (Create_Uniq_Identifier, Type_Info.Ortho_Type (Mode_Value),
               O_Storage_Private, Res);
         elsif Type_Info.Type_Mode = Type_Mode_Array then
            --  Type of string literal isn't statically known; check the
            --  length.
            Chap6.Check_Bound_Error
              (New_Compare_Op
                 (ON_Neq,
                  New_Lit (New_Index_Lit (Unsigned_64 (Len))),
                  Chap3.Get_Array_Type_Length (Lit_Type),
                  Ghdl_Bool_Type),
               Str, 1);
         else
            raise Internal_Error;
         end if;

         R := New_Address (Get_Var (Val),
                           Type_Info.Ortho_Ptr_Type (Mode_Value));
         Free_Var (Val);
         return R;
      end Translate_Non_Static_String_Literal;

      --  Only for Strings of STD.Character.
      function Translate_Static_String (Str_Type : Iir; Str_Ident : Name_Id)
        return O_Cnode
      is
         use Name_Table;

         Literal_List : Iir_List;
         Lit : Iir;
         List : O_Array_Aggr_List;
         Res : O_Cnode;
      begin
         Chap3.Translate_Anonymous_Type_Definition (Str_Type, True);

         Start_Array_Aggr (List, Get_Ortho_Type (Str_Type, Mode_Value));

         Literal_List :=
           Get_Enumeration_Literal_List (Character_Type_Definition);
         Image (Str_Ident);
         for I in 1 .. Name_Length loop
            Lit := Get_Nth_Element (Literal_List,
                                    Character'Pos (Name_Buffer (I)));
            New_Array_Aggr_El (List, Get_Ortho_Expr (Lit));
         end loop;

         Finish_Array_Aggr (List, Res);
         return Res;
      end Translate_Static_String;

      function Translate_Static_Bit_String_Literal
        (Lit : Iir_Bit_String_Literal)
        return O_Cnode
      is
         Lit_Type : Iir;
         Res : O_Cnode;
         List : O_Array_Aggr_List;
      begin
         Lit_Type := Get_Type (Lit);
         Chap3.Translate_Anonymous_Type_Definition (Lit_Type, True);
         Start_Array_Aggr (List, Get_Ortho_Type (Lit_Type, Mode_Value));
         Translate_Static_Bit_String_Literal_Inner (List, Lit, Lit_Type);
         Finish_Array_Aggr (List, Res);
         return Res;
      end Translate_Static_Bit_String_Literal;

      function Translate_String_Literal (Str : Iir) return O_Enode
      is
         Var : Var_Acc;
         Info : Type_Info_Acc;
         Str_Type : Iir;
         Res : O_Cnode;
         R : O_Enode;
      begin
         Str_Type := Get_Type (Str);
         if Get_Constraint_State (Str_Type) = Fully_Constrained
           and then
           Get_Type_Staticness (Get_Index_Type (Str_Type, 0)) = Locally
         then
            case Get_Kind (Str) is
               when Iir_Kind_String_Literal =>
                  Res := Translate_Static_String_Literal (Str);
               when Iir_Kind_Bit_String_Literal =>
                  Res := Translate_Static_Bit_String_Literal (Str);
               when Iir_Kind_Simple_Aggregate =>
                  Res := Translate_Static_Simple_Aggregate (Str);
               when Iir_Kind_Simple_Name_Attribute =>
                  Res := Translate_Static_String
                    (Get_Type (Str), Get_Simple_Name_Identifier (Str));
               when others =>
                  raise Internal_Error;
            end case;
            Str_Type := Get_Type (Str);
            Info := Get_Info (Str_Type);
            Var := Create_Global_Const
              (Create_Uniq_Identifier, Info.Ortho_Type (Mode_Value),
               O_Storage_Private, Res);
            R := New_Address (Get_Var (Var), Info.Ortho_Ptr_Type (Mode_Value));
            Free_Var (Var);
            return R;
         else
            return Translate_Non_Static_String_Literal (Str);
         end if;
      end Translate_String_Literal;

      function Translate_Static_Implicit_Conv
        (Expr : O_Cnode; Expr_Type : Iir; Res_Type : Iir) return O_Cnode
      is
         Expr_Info : Type_Info_Acc;
         Res_Info : Type_Info_Acc;
         Val : Var_Acc;
         Res : O_Cnode;
         List : O_Record_Aggr_List;
         Bound : Var_Acc;
      begin
         if Res_Type = Expr_Type then
            return Expr;
         end if;
         if Get_Kind (Expr_Type) /= Iir_Kind_Array_Subtype_Definition then
            raise Internal_Error;
         end if;
         if Get_Kind (Res_Type) = Iir_Kind_Array_Subtype_Definition then
            return Expr;
         end if;
         if Get_Kind (Res_Type) /= Iir_Kind_Array_Type_Definition then
            raise Internal_Error;
         end if;
         Expr_Info := Get_Info (Expr_Type);
         Res_Info := Get_Info (Res_Type);
         Val := Create_Global_Const
           (Create_Uniq_Identifier, Expr_Info.Ortho_Type (Mode_Value),
            O_Storage_Private, Expr);
         Bound := Expr_Info.T.Array_Bounds;
         if Bound = null then
            Bound := Create_Global_Const
              (Create_Uniq_Identifier, Expr_Info.T.Bounds_Type,
               O_Storage_Private,
               Chap3.Create_Static_Array_Subtype_Bounds (Expr_Type));
            Expr_Info.T.Array_Bounds := Bound;
         end if;

         Start_Record_Aggr (List, Res_Info.Ortho_Type (Mode_Value));
         New_Record_Aggr_El
           (List, New_Global_Address (Get_Var_Label (Val),
                                      Res_Info.T.Base_Ptr_Type (Mode_Value)));
         New_Record_Aggr_El
           (List, New_Global_Address (Get_Var_Label (Bound),
                                      Expr_Info.T.Bounds_Ptr_Type));
         Finish_Record_Aggr (List, Res);
         return Res;
      end Translate_Static_Implicit_Conv;

      function Translate_Numeric_Literal (Expr : Iir; Res_Type : O_Tnode)
        return O_Cnode
      is
      begin
         case Get_Kind (Expr) is
            when Iir_Kind_Integer_Literal =>
               return New_Signed_Literal
                 (Res_Type, Integer_64 (Get_Value (Expr)));

            when Iir_Kind_Enumeration_Literal =>
               return Get_Ortho_Expr (Get_Enumeration_Decl (Expr));

            when Iir_Kind_Floating_Point_Literal =>
               return New_Float_Literal
                 (Res_Type, IEEE_Float_64 (Get_Fp_Value (Expr)));

            when Iir_Kind_Physical_Int_Literal
              | Iir_Kind_Physical_Fp_Literal
              | Iir_Kind_Unit_Declaration =>
               return New_Signed_Literal
                 (Res_Type, Integer_64 (Get_Physical_Value (Expr)));

            when others =>
               Error_Kind ("translate_numeric_literal", Expr);
         end case;
      exception
         when Constraint_Error =>
            --  Can be raised by Get_Physical_Unit_Value because of the kludge
            --  on staticness.
            Error_Msg_Elab ("numeric literal not in range", Expr);
            return New_Signed_Literal (Res_Type, 0);
      end Translate_Numeric_Literal;

      function Translate_Numeric_Literal (Expr : Iir; Res_Type : Iir)
                                         return O_Cnode
      is
         Expr_Type : Iir;
         Expr_Otype : O_Tnode;
         Tinfo : Type_Info_Acc;
      begin
         Expr_Type := Get_Type (Expr);
         Tinfo := Get_Info (Expr_Type);
         if Res_Type /= Null_Iir then
            Expr_Otype := Get_Ortho_Type (Res_Type, Mode_Value);
         else
            if Tinfo = null then
               --  FIXME: this is a working kludge, in the case where EXPR_TYPE
               --  is a subtype which was not yet translated.
               --  (eg: evaluated array attribute)
               Tinfo := Get_Info (Get_Base_Type (Expr_Type));
            end if;
            Expr_Otype := Tinfo.Ortho_Type (Mode_Value);
         end if;
         return Translate_Numeric_Literal (Expr, Expr_Otype);
      end Translate_Numeric_Literal;

      function Translate_Static_Expression (Expr : Iir; Res_Type : Iir)
        return O_Cnode
      is
         Expr_Type : constant Iir := Get_Type (Expr);
      begin
         case Get_Kind (Expr) is
            when Iir_Kind_Integer_Literal
              | Iir_Kind_Enumeration_Literal
              | Iir_Kind_Floating_Point_Literal
              | Iir_Kind_Physical_Int_Literal
              | Iir_Kind_Unit_Declaration
              | Iir_Kind_Physical_Fp_Literal =>
               return Translate_Numeric_Literal (Expr, Res_Type);

            when Iir_Kind_String_Literal =>
               return Translate_Static_Implicit_Conv
                 (Translate_Static_String_Literal (Expr), Expr_Type, Res_Type);
            when Iir_Kind_Bit_String_Literal =>
               return Translate_Static_Implicit_Conv
                 (Translate_Static_Bit_String_Literal (Expr),
                  Expr_Type, Res_Type);
            when Iir_Kind_Simple_Aggregate =>
               return Translate_Static_Implicit_Conv
                 (Translate_Static_Simple_Aggregate (Expr),
                  Expr_Type, Res_Type);
            when Iir_Kind_Aggregate =>
               return Translate_Static_Implicit_Conv
                 (Translate_Static_Aggregate (Expr), Expr_Type, Res_Type);

            when Iir_Kinds_Denoting_Name =>
               return Translate_Static_Expression
                 (Get_Named_Entity (Expr), Res_Type);
            when others =>
               Error_Kind ("translate_static_expression", Expr);
         end case;
      end Translate_Static_Expression;

      function Translate_Static_Range_Left
        (Expr : Iir; Range_Type : Iir := Null_Iir)
        return O_Cnode
      is
         Left : O_Cnode;
         Bound : Iir;
      begin
         Bound := Get_Left_Limit (Expr);
         Left := Chap7.Translate_Static_Expression (Bound, Range_Type);
--       if Range_Type /= Null_Iir and then Get_Type (Bound) /= Range_Type then
--             Left := New_Convert_Ov
--               (Left, Get_Ortho_Type (Range_Type, Mode_Value));
--          end if;
         return Left;
      end Translate_Static_Range_Left;

      function Translate_Static_Range_Right
        (Expr : Iir; Range_Type : Iir := Null_Iir)
        return O_Cnode
      is
         Right : O_Cnode;
      begin
         Right := Chap7.Translate_Static_Expression (Get_Right_Limit (Expr),
                                                     Range_Type);
--          if Range_Type /= Null_Iir then
--             Right := New_Convert_Ov
--               (Right, Get_Ortho_Type (Range_Type, Mode_Value));
--          end if;
         return Right;
      end Translate_Static_Range_Right;

      function Translate_Static_Range_Dir (Expr : Iir) return O_Cnode
      is
      begin
         case Get_Direction (Expr) is
            when Iir_To =>
               return Ghdl_Dir_To_Node;
            when Iir_Downto =>
               return Ghdl_Dir_Downto_Node;
         end case;
      end Translate_Static_Range_Dir;

      function Translate_Static_Range_Length (Expr : Iir) return O_Cnode
      is
         Ulen : Unsigned_64;
      begin
         Ulen := Unsigned_64 (Eval_Discrete_Range_Length (Expr));
         return New_Unsigned_Literal (Ghdl_Index_Type, Ulen);
      end Translate_Static_Range_Length;

      function Translate_Range_Expression_Left (Expr : Iir;
                                                Range_Type : Iir := Null_Iir)
        return O_Enode
      is
         Left : O_Enode;
      begin
         Left := Chap7.Translate_Expression (Get_Left_Limit (Expr));
         if Range_Type /= Null_Iir then
            Left := New_Convert_Ov (Left,
                                    Get_Ortho_Type (Range_Type, Mode_Value));
         end if;
         return Left;
      end Translate_Range_Expression_Left;

      function Translate_Range_Expression_Right (Expr : Iir;
                                                 Range_Type : Iir := Null_Iir)
        return O_Enode
      is
         Right : O_Enode;
      begin
         Right := Chap7.Translate_Expression (Get_Right_Limit (Expr));
         if Range_Type /= Null_Iir then
            Right := New_Convert_Ov (Right,
                                     Get_Ortho_Type (Range_Type, Mode_Value));
         end if;
         return Right;
      end Translate_Range_Expression_Right;

      --  Compute the length of LEFT DIR (to/downto) RIGHT.
      function Compute_Range_Length
        (Left : O_Enode; Right : O_Enode; Dir : Iir_Direction)
        return O_Enode
      is
         L : O_Enode;
         R : O_Enode;
         Val : O_Enode;
         Tmp : O_Dnode;
         Res : O_Dnode;
         If_Blk : O_If_Block;
         Rng_Type : O_Tnode;
      begin
         Rng_Type := Ghdl_I32_Type;
         L := New_Convert_Ov (Left, Rng_Type);
         R := New_Convert_Ov (Right, Rng_Type);

         case Dir is
            when Iir_To =>
               Val := New_Dyadic_Op (ON_Sub_Ov, R, L);
            when Iir_Downto =>
               Val := New_Dyadic_Op (ON_Sub_Ov, L, R);
         end case;

         Res := Create_Temp (Ghdl_Index_Type);
         Open_Temp;
         Tmp := Create_Temp (Rng_Type);
         New_Assign_Stmt (New_Obj (Tmp), Val);
         Start_If_Stmt
           (If_Blk,
            New_Compare_Op (ON_Lt, New_Obj_Value (Tmp),
                            New_Lit (New_Signed_Literal (Rng_Type, 0)),
                            Ghdl_Bool_Type));
         Init_Var (Res);
         New_Else_Stmt (If_Blk);
         Val := New_Convert_Ov (New_Obj_Value (Tmp), Ghdl_Index_Type);
         Val := New_Dyadic_Op (ON_Add_Ov, Val, New_Lit (Ghdl_Index_1));
         New_Assign_Stmt (New_Obj (Res), Val);
         Finish_If_Stmt (If_Blk);
         Close_Temp;
         return New_Obj_Value (Res);
      end Compute_Range_Length;

      function Translate_Range_Expression_Length (Expr : Iir) return O_Enode
      is
         Left, Right : O_Enode;
      begin
         if Get_Expr_Staticness (Expr) = Locally then
            return New_Lit (Translate_Static_Range_Length (Expr));
         else
            Left := Chap7.Translate_Expression (Get_Left_Limit (Expr));
            Right := Chap7.Translate_Expression (Get_Right_Limit (Expr));

            return Compute_Range_Length (Left, Right, Get_Direction (Expr));
         end if;
      end Translate_Range_Expression_Length;

      function Translate_Range_Length (Expr : Iir) return O_Enode is
      begin
         case Get_Kind (Expr) is
            when Iir_Kind_Range_Expression =>
               return Translate_Range_Expression_Length (Expr);
            when Iir_Kind_Range_Array_Attribute =>
               return Chap14.Translate_Length_Array_Attribute (Expr, Null_Iir);
            when others =>
               Error_Kind ("translate_range_length", Expr);
         end case;
      end Translate_Range_Length;

      function Translate_Association (Assoc : Iir) return O_Enode
      is
         Formal : constant Iir := Get_Formal (Assoc);
         Formal_Base : constant Iir := Get_Association_Interface (Assoc);
         Actual : Iir;
      begin
         case Get_Kind (Assoc) is
            when Iir_Kind_Association_Element_By_Expression =>
               Actual := Get_Actual (Assoc);
            when Iir_Kind_Association_Element_Open =>
               Actual := Get_Default_Value (Formal);
            when others =>
               Error_Kind ("translate_association", Assoc);
         end case;

         case Get_Kind (Formal_Base) is
            when Iir_Kind_Constant_Interface_Declaration
              | Iir_Kind_File_Interface_Declaration =>
               return Chap3.Maybe_Insert_Scalar_Check
                 (Translate_Expression (Actual, Get_Type (Formal)),
                  Actual, Get_Type (Formal));
            when Iir_Kind_Signal_Interface_Declaration =>
               return Translate_Implicit_Conv
                 (M2E (Chap6.Translate_Name (Actual)),
                  Get_Type (Actual),
                  Get_Type (Formal_Base),
                  Mode_Signal, Assoc);
            when others =>
               Error_Kind ("translate_association", Formal);
         end case;
      end Translate_Association;

      function Translate_Function_Call
        (Imp : Iir; Assoc_Chain : Iir; Obj : Iir)
        return O_Enode
      is
         Info : constant Subprg_Info_Acc := Get_Info (Imp);
         Constr : O_Assoc_List;
         Assoc : Iir;
         Res : Mnode;
      begin
         if Info.Use_Stack2 then
            Create_Temp_Stack2_Mark;
         end if;

         if Info.Res_Interface /= O_Dnode_Null then
            --  Composite result.
            --  If we need to allocate, do it before starting the call!
            declare
               Res_Type : Iir;
               Res_Info : Type_Info_Acc;
            begin
               Res_Type := Get_Return_Type (Imp);
               Res_Info := Get_Info (Res_Type);
               Res := Create_Temp (Res_Info);
               if Res_Info.Type_Mode /= Type_Mode_Fat_Array then
                  Chap4.Allocate_Complex_Object (Res_Type, Alloc_Stack, Res);
               end if;
            end;
         end if;

         Start_Association (Constr, Info.Ortho_Func);

         if Info.Res_Interface /= O_Dnode_Null then
            --  Composite result.
            New_Association (Constr, M2E (Res));
         end if;

         --  If the subprogram is a method, pass the protected object.
         if Obj /= Null_Iir then
            New_Association (Constr, M2E (Chap6.Translate_Name (Obj)));
         else
            Chap2.Add_Subprg_Instance_Assoc (Constr, Info.Subprg_Instance);
         end if;

         Assoc := Assoc_Chain;
         while Assoc /= Null_Iir loop
            --  FIXME: evaluate expression before, because we
            --  may allocate objects.
            New_Association (Constr, Translate_Association (Assoc));
            Assoc := Get_Chain (Assoc);
         end loop;

         if Info.Res_Interface /= O_Dnode_Null then
            --  Composite result.
            New_Procedure_Call (Constr);
            return M2E (Res);
         else
            return New_Function_Call (Constr);
         end if;
      end Translate_Function_Call;

      function Translate_Operator_Function_Call
        (Imp : Iir; Left : Iir;  Right : Iir; Res_Type : Iir)
        return O_Enode
      is
         function Create_Assoc (Actual : Iir; Formal : Iir)
           return Iir
         is
            R : Iir;
         begin
            R := Create_Iir (Iir_Kind_Association_Element_By_Expression);
            Location_Copy (R, Actual);
            Set_Actual (R, Actual);
            Set_Formal (R, Formal);
            return R;
         end Create_Assoc;

         Inter : Iir;
         El_L : Iir;
         El_R : Iir;
         Res : O_Enode;
      begin
         Inter := Get_Interface_Declaration_Chain (Imp);

         El_L := Create_Assoc (Left, Inter);

         if Right /= Null_Iir then
            Inter := Get_Chain (Inter);
            El_R := Create_Assoc (Right, Inter);
            Set_Chain (El_L, El_R);
         end if;

         Res := Translate_Function_Call (Imp, El_L, Null_Iir);

         Free_Iir (El_L);
         if Right /= Null_Iir then
            Free_Iir (El_R);
         end if;

         return Translate_Implicit_Conv
           (Res, Get_Return_Type (Imp), Res_Type, Mode_Value, Left);
      end Translate_Operator_Function_Call;

      function Convert_Constrained_To_Unconstrained
        (Expr : O_Enode; Expr_Type : Iir; Atype : Iir; Kind : Object_Kind_Type)
        return O_Enode
      is
         Res : O_Dnode;
         Type_Info : Type_Info_Acc;
      begin
         -- FIXME: to do.
         --  Be sure the bounds variable was created.
         --  This may be necessary for on-the-fly types, such as strings.
         Chap3.Create_Array_Subtype (Expr_Type, True);

         Type_Info := Get_Info (Atype);
         Res := Create_Temp (Type_Info.Ortho_Type (Kind));
         New_Assign_Stmt
           (New_Selected_Element (New_Obj (Res),
                                  Type_Info.T.Base_Field (Kind)),
            New_Convert_Ov (Expr, Type_Info.T.Base_Ptr_Type (Kind)));

         New_Assign_Stmt
           (New_Selected_Element (New_Obj (Res),
                                  Type_Info.T.Bounds_Field (Kind)),
            Chap3.Get_Array_Ptr_Bounds_Ptr (O_Lnode_Null, Expr_Type, Kind));
         return L2e_Node (New_Obj (Res), Type_Info, Kind);
      end Convert_Constrained_To_Unconstrained;

      function Convert_Array_To_Thin_Array
        (Expr : O_Enode;
         Expr_Type : Iir;
         Atype : Iir;
         Is_Sig : Object_Kind_Type;
         Loc : Iir)
        return O_Enode
      is
         Ptr : O_Dnode;
         Expr_Type_Info : Type_Info_Acc;
         Expr_Indexes: Iir_List;
         Success_Label, Failure_Label : O_Snode;
      begin
         Expr_Type_Info := Get_Info (Expr_Type);
         Ptr := Create_Temp_Init
           (Expr_Type_Info.Ortho_Ptr_Type (Is_Sig), Expr);

         Open_Temp;
         --  Check each dimension.
         Expr_Indexes := Get_Index_Subtype_List (Expr_Type);
         Start_Loop_Stmt (Success_Label);
         Start_Loop_Stmt (Failure_Label);
         for I in 1 .. Get_Nbr_Elements (Expr_Indexes) loop
            Gen_Exit_When
              (Failure_Label,
               New_Compare_Op
               (ON_Neq,
                Chap6.Get_Array_Ptr_Bound_Length (New_Obj (Ptr),
                                                  Expr_Type, I, Is_Sig),
                Chap6.Get_Array_Bound_Length (O_Lnode_Null, Atype, I, Is_Sig),
                Ghdl_Bool_Type));
         end loop;
         New_Exit_Stmt (Success_Label);
         Finish_Loop_Stmt (Failure_Label);
         Chap6.Gen_Bound_Error (Loc);
         Finish_Loop_Stmt (Success_Label);
         Close_Temp;

         return New_Value
           (Chap3.Get_Array_Ptr_Base_Ptr (New_Obj (Ptr), Expr_Type, Is_Sig));
      end Convert_Array_To_Thin_Array;

      --  Convert (if necessary) EXPR translated from EXPR_ORIG to type ATYPE.
      function Translate_Implicit_Conv (Expr : O_Enode;
                                        Expr_Type : Iir;
                                        Atype : Iir;
                                        Is_Sig : Object_Kind_Type;
                                        Loc : Iir)
        return O_Enode
      is
         Ainfo : Type_Info_Acc;
         Einfo : Type_Info_Acc;
      begin
         if Atype = Expr_Type then
            return Expr;
         end if;
         if Expr_Type = Universal_Integer_Type_Definition then
            return New_Convert_Ov (Expr, Get_Ortho_Type (Atype, Mode_Value));
         elsif Expr_Type = Universal_Real_Type_Definition then
            return New_Convert_Ov (Expr, Get_Ortho_Type (Atype, Mode_Value));
         elsif Get_Kind (Expr_Type) in Iir_Kinds_Array_Type_Definition then
            Ainfo := Get_Info (Atype);
            Einfo := Get_Info (Expr_Type);
            case Ainfo.Type_Mode is
               when Type_Mode_Fat_Array =>
                  --  X to unconstrained.
                  case Einfo.Type_Mode is
                     when Type_Mode_Fat_Array =>
                        --  unconstrained to unconstrained.
                        return Expr;
                     when Type_Mode_Array =>
                        --  constrained to unconstrained.
                        return Convert_Constrained_To_Unconstrained
                          (Expr, Expr_Type, Atype, Is_Sig);
                     when others =>
                        raise Internal_Error;
                  end case;
               when Type_Mode_Array =>
                  --  X to constrained.
                  if Einfo.Type_Locally_Constrained
                    and then Ainfo.Type_Locally_Constrained
                  then
                     --  FIXME: optimize static vs non-static
                     --  constrained to constrained.
                     --  FIXME: share with check_array_match ?
                     declare
                        E_List : constant Iir_List :=
                          Get_Index_Subtype_List (Expr_Type);
                        A_List : constant Iir_List :=
                          Get_Index_Subtype_List (Atype);
                        E_El, A_El : Iir;
                     begin
                        for I in Natural loop
                           E_El := Get_Index_Type (E_List, I);
                           A_El := Get_Index_Type (A_List, I);
                           exit when E_El = Null_Iir
                             and then A_El = Null_Iir;
                           if Eval_Discrete_Type_Length (E_El)
                             /= Eval_Discrete_Type_Length (A_El)
                           then
                              --  FIXME: generate a bound error ?
                              --  Even if this is caught at compile-time,
                              --  the code is not required to run.
                              Chap6.Gen_Bound_Error (Loc);
                           end if;
                        end loop;
                     end;
                     return Expr;
                  else
                     --  unconstrained to constrained.
                     return Convert_Array_To_Thin_Array
                       (Expr, Expr_Type, Atype, Is_Sig, Loc);
                  end if;
               when others =>
                  raise Internal_Error;
            end case;
         else
            return Expr;
         end if;
      end Translate_Implicit_Conv;

      type Predefined_To_Onop_Type is array (Iir_Predefined_Functions)
        of ON_Op_Kind;
      Predefined_To_Onop : constant Predefined_To_Onop_Type :=
        (Iir_Predefined_Boolean_Or => ON_Or,
         Iir_Predefined_Boolean_Not => ON_Not,
         Iir_Predefined_Boolean_And => ON_And,
         Iir_Predefined_Boolean_Xor => ON_Xor,

         Iir_Predefined_Bit_Not => ON_Not,
         Iir_Predefined_Bit_And => ON_And,
         Iir_Predefined_Bit_Or => ON_Or,
         Iir_Predefined_Bit_Xor => ON_Xor,

         Iir_Predefined_Integer_Equality => ON_Eq,
         Iir_Predefined_Integer_Inequality => ON_Neq,
         Iir_Predefined_Integer_Less_Equal => ON_Le,
         Iir_Predefined_Integer_Less => ON_Lt,
         Iir_Predefined_Integer_Greater => ON_Gt,
         Iir_Predefined_Integer_Greater_Equal => ON_Ge,
         Iir_Predefined_Integer_Plus => ON_Add_Ov,
         Iir_Predefined_Integer_Minus => ON_Sub_Ov,
         Iir_Predefined_Integer_Mul => ON_Mul_Ov,
         Iir_Predefined_Integer_Rem => ON_Rem_Ov,
         Iir_Predefined_Integer_Mod => ON_Mod_Ov,
         Iir_Predefined_Integer_Div => ON_Div_Ov,
         Iir_Predefined_Integer_Absolute => ON_Abs_Ov,
         Iir_Predefined_Integer_Negation => ON_Neg_Ov,

         Iir_Predefined_Enum_Equality => ON_Eq,
         Iir_Predefined_Enum_Inequality => ON_Neq,
         Iir_Predefined_Enum_Greater_Equal => ON_Ge,
         Iir_Predefined_Enum_Greater => ON_Gt,
         Iir_Predefined_Enum_Less => ON_Lt,
         Iir_Predefined_Enum_Less_Equal => ON_Le,

         Iir_Predefined_Physical_Equality => ON_Eq,
         Iir_Predefined_Physical_Inequality => ON_Neq,
         Iir_Predefined_Physical_Less => ON_Lt,
         Iir_Predefined_Physical_Less_Equal => ON_Le,
         Iir_Predefined_Physical_Greater => ON_Gt,
         Iir_Predefined_Physical_Greater_Equal => ON_Ge,
         Iir_Predefined_Physical_Negation => ON_Neg_Ov,
         Iir_Predefined_Physical_Absolute => ON_Abs_Ov,
         Iir_Predefined_Physical_Minus => ON_Sub_Ov,
         Iir_Predefined_Physical_Plus => ON_Add_Ov,

         Iir_Predefined_Floating_Greater => ON_Gt,
         Iir_Predefined_Floating_Greater_Equal => ON_Ge,
         Iir_Predefined_Floating_Less => ON_Lt,
         Iir_Predefined_Floating_Less_Equal => ON_Le,
         Iir_Predefined_Floating_Equality => ON_Eq,
         Iir_Predefined_Floating_Inequality => ON_Neq,
         Iir_Predefined_Floating_Minus => ON_Sub_Ov,
         Iir_Predefined_Floating_Plus => ON_Add_Ov,
         Iir_Predefined_Floating_Mul => ON_Mul_Ov,
         Iir_Predefined_Floating_Div => ON_Div_Ov,
         Iir_Predefined_Floating_Negation => ON_Neg_Ov,
         Iir_Predefined_Floating_Absolute => ON_Abs_Ov,

         others => ON_Nil);

      function Translate_Shortcut_Operator
        (Imp : Iir_Implicit_Function_Declaration; Left, Right : Iir)
        return O_Enode
      is
         Rtype : Iir;
         Res : O_Dnode;
         Res_Type : O_Tnode;
         If_Blk : O_If_Block;
         Val : Integer;
         V : O_Cnode;
         Kind : Iir_Predefined_Functions;
         Invert : Boolean;
      begin
         Rtype := Get_Return_Type (Imp);
         Res_Type := Get_Ortho_Type (Rtype, Mode_Value);
         Res := Create_Temp (Res_Type);
         Open_Temp;
         New_Assign_Stmt (New_Obj (Res), Chap7.Translate_Expression (Left));
         Close_Temp;
         Kind := Get_Implicit_Definition (Imp);

         --  Short cut: RIGHT is the result (and must be evaluated) iff
         --  LEFT is equal to VAL (ie '0' or false for 0, '1' or true for 1).
         case Kind is
            when Iir_Predefined_Bit_And
              | Iir_Predefined_Boolean_And =>
               Invert := False;
               Val := 1;
            when Iir_Predefined_Bit_Nand
              | Iir_Predefined_Boolean_Nand =>
               Invert := True;
               Val := 1;
            when Iir_Predefined_Bit_Or
              | Iir_Predefined_Boolean_Or =>
               Invert := False;
               Val := 0;
            when Iir_Predefined_Bit_Nor
              | Iir_Predefined_Boolean_Nor =>
               Invert := True;
               Val := 0;
            when others =>
               Ada.Text_IO.Put_Line
                 ("translate_shortcut_operator: cannot handle "
                  & Iir_Predefined_Functions'Image (Kind));
               raise Internal_Error;
         end case;

         V := Get_Ortho_Expr
           (Get_Nth_Element (Get_Enumeration_Literal_List (Rtype), Val));
         Start_If_Stmt (If_Blk,
                        New_Compare_Op (ON_Eq,
                                        New_Obj_Value (Res), New_Lit (V),
                                        Ghdl_Bool_Type));
         Open_Temp;
         New_Assign_Stmt (New_Obj (Res), Chap7.Translate_Expression (Right));
         Close_Temp;
         Finish_If_Stmt (If_Blk);
         if Invert then
            return New_Monadic_Op (ON_Not, New_Obj_Value (Res));
         else
            return New_Obj_Value (Res);
         end if;
      end Translate_Shortcut_Operator;

      function Translate_Lib_Operator (Left, Right : O_Enode; Func : O_Dnode)
        return O_Enode
      is
         Constr : O_Assoc_List;
      begin
         Start_Association (Constr, Func);
         New_Association (Constr, Left);
         if Right /= O_Enode_Null then
            New_Association (Constr, Right);
         end if;
         return New_Function_Call (Constr);
      end Translate_Lib_Operator;

      function Translate_Predefined_Lib_Operator
        (Left, Right : O_Enode; Func : Iir_Implicit_Function_Declaration)
        return O_Enode
      is
         Info : Subprg_Info_Acc;
         Constr : O_Assoc_List;
      begin
         Info := Get_Info (Func);
         Start_Association (Constr, Info.Ortho_Func);
         Chap2.Add_Subprg_Instance_Assoc (Constr, Info.Subprg_Instance);
         New_Association (Constr, Left);
         if Right /= O_Enode_Null then
            New_Association (Constr, Right);
         end if;
         return New_Function_Call (Constr);
      end Translate_Predefined_Lib_Operator;

      function Translate_Predefined_Array_Operator
        (Left, Right : O_Enode; Func : Iir)
        return O_Enode
      is
         Res : O_Dnode;
         Constr : O_Assoc_List;
         Info : Type_Info_Acc;
         Func_Info : Subprg_Info_Acc;
      begin
         Create_Temp_Stack2_Mark;
         Info := Get_Info (Get_Return_Type (Func));
         Res := Create_Temp (Info.Ortho_Type (Mode_Value));
         Func_Info := Get_Info (Func);
         Start_Association (Constr, Func_Info.Ortho_Func);
         Chap2.Add_Subprg_Instance_Assoc (Constr, Func_Info.Subprg_Instance);
         New_Association (Constr,
                          New_Address (New_Obj (Res),
                                       Info.Ortho_Ptr_Type (Mode_Value)));
         New_Association (Constr, Left);
         if Right /= O_Enode_Null then
            New_Association (Constr, Right);
         end if;
         New_Procedure_Call (Constr);
         return New_Address (New_Obj (Res), Info.Ortho_Ptr_Type (Mode_Value));
      end Translate_Predefined_Array_Operator;

      function Translate_Predefined_Array_Operator_Convert
        (Left, Right : O_Enode; Func : Iir; Res_Type : Iir)
        return O_Enode
      is
         Res : O_Enode;
         Ret_Type : Iir;
      begin
         Ret_Type := Get_Return_Type (Func);
         Res := Translate_Predefined_Array_Operator (Left, Right, Func);
         return Translate_Implicit_Conv
           (Res, Ret_Type, Res_Type, Mode_Value, Func);
      end Translate_Predefined_Array_Operator_Convert;

      --  Create an array aggregate containing one element, EL.
      function Translate_Element_To_Array (El : O_Enode; Arr_Type : Iir)
        return O_Enode
      is
         Res : O_Dnode;
         Ainfo : Type_Info_Acc;
         Einfo : Type_Info_Acc;
         V : O_Dnode;
      begin
         Ainfo := Get_Info (Arr_Type);
         Einfo := Get_Info (Get_Element_Subtype (Arr_Type));
         Res := Create_Temp (Ainfo.Ortho_Type (Mode_Value));
         if Is_Composite (Einfo) then
            New_Assign_Stmt
              (New_Selected_Element (New_Obj (Res),
                                     Ainfo.T.Base_Field (Mode_Value)),
               New_Convert_Ov (El, Ainfo.T.Base_Ptr_Type (Mode_Value)));
         else
            V := Create_Temp_Init (Einfo.Ortho_Type (Mode_Value), El);
            New_Assign_Stmt
              (New_Selected_Element (New_Obj (Res),
                                     Ainfo.T.Base_Field (Mode_Value)),
               New_Convert_Ov (New_Address (New_Obj (V),
                                            Einfo.Ortho_Ptr_Type (Mode_Value)),
                               Ainfo.T.Base_Ptr_Type (Mode_Value)));
         end if;
         New_Assign_Stmt
           (New_Selected_Element (New_Obj (Res),
                                  Ainfo.T.Bounds_Field (Mode_Value)),
            New_Address (Get_Var (Ainfo.T.Array_1bound),
                         Ainfo.T.Bounds_Ptr_Type));
         return New_Address (New_Obj (Res), Ainfo.Ortho_Ptr_Type (Mode_Value));
      end Translate_Element_To_Array;

      function Translate_Concat_Operator
        (Left_Tree, Right_Tree : O_Enode;
         Imp : Iir_Implicit_Function_Declaration;
         Res_Type : Iir;
         Loc : Iir)
        return O_Enode
      is
         Arr_El1 : O_Enode;
         Arr_El2 : O_Enode;
         Ret_Type : Iir;
         Res : O_Enode;
         Kind : Iir_Predefined_Functions;
      begin
         Ret_Type := Get_Return_Type (Imp);
         Kind := Get_Implicit_Definition (Imp);
         case Kind is
            when Iir_Predefined_Element_Array_Concat
              | Iir_Predefined_Element_Element_Concat =>
               Arr_El1 := Translate_Element_To_Array (Left_Tree, Ret_Type);
            when others =>
               Arr_El1 := Left_Tree;
         end case;
         case Kind is
            when Iir_Predefined_Array_Element_Concat
              | Iir_Predefined_Element_Element_Concat =>
               Arr_El2 := Translate_Element_To_Array (Right_Tree, Ret_Type);
            when others =>
               Arr_El2 := Right_Tree;
         end case;
         Res := Translate_Predefined_Array_Operator (Arr_El1, Arr_El2, Imp);
         return Translate_Implicit_Conv
           (Res, Ret_Type, Res_Type, Mode_Value, Loc);
      end Translate_Concat_Operator;

      function Translate_Predefined_Operator
        (Imp : Iir_Implicit_Function_Declaration;
         Left, Right : Iir;
         Res_Type : Iir;
         Loc : Iir)
        return O_Enode
      is
         Left_Tree : O_Enode;
         Right_Tree : O_Enode;
         Kind : Iir_Predefined_Functions;
         Left_Type : Iir;
         Right_Type : Iir;
         Res_Otype : O_Tnode;
         Op : ON_Op_Kind;
         Inter : Iir;
         Res : O_Enode;
      begin
         Kind := Get_Implicit_Definition (Imp);
         if Iir_Predefined_Shortcut_P (Kind) then
            return Translate_Shortcut_Operator (Imp, Left, Right);
         end if;

         Res_Otype := Get_Ortho_Type (Res_Type, Mode_Value);
         Inter := Get_Interface_Declaration_Chain (Imp);
         if Left = Null_Iir then
            Left_Tree := O_Enode_Null;
         else
            Left_Type := Get_Type (Inter);
            Left_Tree := Translate_Expression (Left, Left_Type);
         end if;

         if Right = Null_Iir then
            Right_Tree := O_Enode_Null;
         else
            Right_Type := Get_Type (Get_Chain (Inter));
            Right_Tree := Translate_Expression (Right, Right_Type);
         end if;

         Op := Predefined_To_Onop (Kind);
         if Op /= ON_Nil then
            case Op is
               when ON_Eq
                 | ON_Neq
                 | ON_Ge
                 | ON_Gt
                 | ON_Le
                 | ON_Lt =>
                  Res := New_Compare_Op (Op, Left_Tree, Right_Tree,
                                         Std_Boolean_Type_Node);
               when ON_Add_Ov
                 | ON_Sub_Ov
                 | ON_Mul_Ov
                 | ON_Div_Ov
                 | ON_Rem_Ov
                 | ON_Mod_Ov
                 | ON_Xor =>
                  Res := New_Dyadic_Op (Op, Left_Tree, Right_Tree);
               when ON_Abs_Ov
                 | ON_Neg_Ov
                 | ON_Not =>
                  Res := New_Monadic_Op (Op, Left_Tree);
               when others =>
                  Ada.Text_IO.Put_Line
                    ("translate_predefined_operator: cannot handle "
                     & ON_Op_Kind'Image (Op));
                  raise Internal_Error;
            end case;
            Res := Translate_Implicit_Conv
              (Res, Get_Return_Type (Imp), Res_Type, Mode_Value, Loc);
            return Res;
         end if;

         case Kind is
            when Iir_Predefined_Bit_Xnor
              | Iir_Predefined_Boolean_Xnor =>
               return New_Monadic_Op
                 (ON_Not, New_Dyadic_Op (ON_Xor, Left_Tree, Right_Tree));

            when Iir_Predefined_Integer_Identity
              | Iir_Predefined_Floating_Identity
              | Iir_Predefined_Physical_Identity =>
               return Translate_Implicit_Conv
                 (Left_Tree, Left_Type, Res_Type, Mode_Value, Loc);

            when Iir_Predefined_Access_Equality
              | Iir_Predefined_Access_Inequality =>
               if Is_Composite (Get_Info (Left_Type)) then
                  --  a fat pointer.
                  declare
                     T : Type_Info_Acc;
                     B : Type_Info_Acc;
                     L, R : O_Dnode;
                     V1, V2 : O_Enode;
                     Op1, Op2 : ON_Op_Kind;
                  begin
                     if Kind = Iir_Predefined_Access_Equality then
                        Op1 := ON_Eq;
                        Op2 := ON_And;
                     else
                        Op1 := ON_Neq;
                        Op2 := ON_Or;
                     end if;
                     T := Get_Info (Left_Type);
                     B := Get_Info (Get_Designated_Type (Left_Type));
                     L := Create_Temp (T.Ortho_Ptr_Type (Mode_Value));
                     R := Create_Temp (T.Ortho_Ptr_Type (Mode_Value));
                     New_Assign_Stmt (New_Obj (L), Left_Tree);
                     New_Assign_Stmt (New_Obj (R), Right_Tree);
                     V1 := New_Compare_Op
                       (Op1,
                        New_Value_Selected_Acc_Value
                        (New_Obj (L), B.T.Base_Field (Mode_Value)),
                        New_Value_Selected_Acc_Value
                        (New_Obj (R), B.T.Base_Field (Mode_Value)),
                        Std_Boolean_Type_Node);
                     V2 := New_Compare_Op
                       (Op1,
                        New_Value_Selected_Acc_Value
                        (New_Obj (L), B.T.Bounds_Field (Mode_Value)),
                        New_Value_Selected_Acc_Value
                        (New_Obj (R), B.T.Bounds_Field (Mode_Value)),
                        Std_Boolean_Type_Node);
                     return New_Dyadic_Op (Op2, V1, V2);
                  end;
               else
                  --  a thin pointer.
                  if Kind = Iir_Predefined_Access_Equality then
                     return New_Compare_Op
                       (ON_Eq, Left_Tree, Right_Tree, Std_Boolean_Type_Node);
                  else
                     return New_Compare_Op
                       (ON_Neq, Left_Tree, Right_Tree, Std_Boolean_Type_Node);
                  end if;
               end if;

            when Iir_Predefined_Physical_Integer_Div =>
               return New_Dyadic_Op (ON_Div_Ov, Left_Tree,
                                     New_Convert_Ov (Right_Tree, Res_Otype));
            when Iir_Predefined_Physical_Physical_Div =>
               return New_Convert_Ov
                 (New_Dyadic_Op (ON_Div_Ov, Left_Tree, Right_Tree), Res_Otype);

            --  LRM 7.2.6
            --  Multiplication of a value P of a physical type Tp by a
            --  value I of type INTEGER is equivalent to the following
            --  computation: Tp'Val (Tp'Pos (P) * I)
            --  FIXME: this is not what is really done...
            when Iir_Predefined_Integer_Physical_Mul =>
               return New_Dyadic_Op (ON_Mul_Ov,
                                     New_Convert_Ov (Left_Tree, Res_Otype),
                                     Right_Tree);
            when Iir_Predefined_Physical_Integer_Mul =>
               return New_Dyadic_Op (ON_Mul_Ov, Left_Tree,
                                     New_Convert_Ov (Right_Tree, Res_Otype));

            --  LRM 7.2.6
            --  Multiplication of a value P of a physical type Tp by a
            --  value F of type REAL is equivalten to the following
            --  computation: Tp'Val (INTEGER (REAL (Tp'Pos (P)) * F))
            --  FIXME: we do not restrict with INTEGER.
            when Iir_Predefined_Physical_Real_Mul =>
               declare
                  Right_Otype : O_Tnode;
               begin
                  Right_Otype := Get_Ortho_Type (Right_Type, Mode_Value);
                  return New_Convert_Ov
                    (New_Dyadic_Op (ON_Mul_Ov,
                                    New_Convert_Ov (Left_Tree, Right_Otype),
                                    Right_Tree),
                     Res_Otype);
               end;
            when Iir_Predefined_Physical_Real_Div =>
               declare
                  Right_Otype : O_Tnode;
               begin
                  Right_Otype := Get_Ortho_Type (Right_Type, Mode_Value);
                  return New_Convert_Ov
                    (New_Dyadic_Op (ON_Div_Ov,
                                    New_Convert_Ov (Left_Tree, Right_Otype),
                                    Right_Tree),
                     Res_Otype);
               end;
            when Iir_Predefined_Real_Physical_Mul =>
               declare
                  Left_Otype : O_Tnode;
               begin
                  Left_Otype := Get_Ortho_Type (Left_Type, Mode_Value);
                  return New_Convert_Ov
                    (New_Dyadic_Op (ON_Mul_Ov,
                                    Left_Tree,
                                    New_Convert_Ov (Right_Tree, Left_Otype)),
                     Res_Otype);
               end;

            when Iir_Predefined_Universal_R_I_Mul =>
               return New_Dyadic_Op (ON_Mul_Ov,
                                     Left_Tree,
                                     New_Convert_Ov (Right_Tree, Res_Otype));

            when Iir_Predefined_Floating_Exp =>
               Res := Translate_Lib_Operator
                 (New_Convert_Ov (Left_Tree, Std_Real_Type_Node),
                  Right_Tree, Ghdl_Real_Exp);
               return New_Convert_Ov (Res, Res_Otype);
            when Iir_Predefined_Integer_Exp =>
               Res := Translate_Lib_Operator
                 (New_Convert_Ov (Left_Tree, Std_Integer_Type_Node),
                  Right_Tree,
                  Ghdl_Integer_Exp);
               return New_Convert_Ov (Res, Res_Otype);

            when Iir_Predefined_Array_Inequality
              | Iir_Predefined_Record_Inequality =>
               return New_Monadic_Op
                 (ON_Not, Translate_Predefined_Lib_Operator
                  (Left_Tree, Right_Tree, Imp));
            when Iir_Predefined_Array_Equality
              | Iir_Predefined_Record_Equality =>
               return Translate_Predefined_Lib_Operator
                 (Left_Tree, Right_Tree, Imp);

            when Iir_Predefined_Array_Greater =>
               return New_Compare_Op
                 (ON_Eq,
                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
                                                     Imp),
                  New_Lit (Ghdl_Compare_Gt),
                  Std_Boolean_Type_Node);
            when Iir_Predefined_Array_Greater_Equal =>
               return New_Compare_Op
                 (ON_Ge,
                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
                                                     Imp),
                  New_Lit (Ghdl_Compare_Eq),
                  Std_Boolean_Type_Node);
            when Iir_Predefined_Array_Less =>
               return New_Compare_Op
                 (ON_Eq,
                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
                                                     Imp),
                  New_Lit (Ghdl_Compare_Lt),
                  Std_Boolean_Type_Node);
            when Iir_Predefined_Array_Less_Equal =>
               return New_Compare_Op
                 (ON_Le,
                  Translate_Predefined_Lib_Operator (Left_Tree, Right_Tree,
                                                     Imp),
                  New_Lit (Ghdl_Compare_Eq),
                  Std_Boolean_Type_Node);

            when Iir_Predefined_TF_Array_And
              | Iir_Predefined_TF_Array_Or
              | Iir_Predefined_TF_Array_Nand
              | Iir_Predefined_TF_Array_Nor
              | Iir_Predefined_TF_Array_Xor
              | Iir_Predefined_TF_Array_Xnor
              | Iir_Predefined_TF_Array_Not
              | Iir_Predefined_Array_Srl
              | Iir_Predefined_Array_Sra
              | Iir_Predefined_Array_Ror =>
               return Translate_Predefined_Array_Operator_Convert
                 (Left_Tree, Right_Tree, Imp, Res_Type);

            when Iir_Predefined_Array_Sll
              | Iir_Predefined_Array_Sla
              | Iir_Predefined_Array_Rol =>
               Right_Tree := New_Monadic_Op (ON_Neg_Ov, Right_Tree);
               return Translate_Predefined_Array_Operator_Convert
                 (Left_Tree, Right_Tree, Imp, Res_Type);

            when Iir_Predefined_Array_Array_Concat
              | Iir_Predefined_Element_Array_Concat
              | Iir_Predefined_Array_Element_Concat
              | Iir_Predefined_Element_Element_Concat =>
               return Translate_Concat_Operator
                 (Left_Tree, Right_Tree, Imp, Res_Type, Loc);

            when Iir_Predefined_Endfile =>
               return Translate_Lib_Operator
                 (Left_Tree, O_Enode_Null, Ghdl_File_Endfile);

            when Iir_Predefined_Now_Function =>
               return New_Obj_Value (Ghdl_Now);

            when others =>
               Ada.Text_IO.Put_Line
                 ("translate_predefined_operator(2): cannot handle "
                  & Iir_Predefined_Functions'Image (Kind));
               raise Internal_Error;
               return O_Enode_Null;
         end case;
      end Translate_Predefined_Operator;

      --  Assign EXPR to TARGET.
      procedure Translate_Assign
        (Target : Mnode;
         Val : O_Enode; Expr : Iir; Target_Type : Iir; Loc : Iir)
      is
         T_Info : constant Type_Info_Acc := Get_Info (Target_Type);
      begin
         case T_Info.Type_Mode is
            when Type_Mode_Scalar =>
               New_Assign_Stmt
                 (M2Lv (Target),
                  Chap3.Maybe_Insert_Scalar_Check (Val, Expr, Target_Type));
            when Type_Mode_Acc
              | Type_Mode_File =>
               New_Assign_Stmt (M2Lv (Target), Val);
            when Type_Mode_Fat_Acc =>
               declare
                  T, E : O_Dnode;
               begin
                  T := Create_Temp_Ptr
                    (Target_Type, M2Lv (Target), Mode_Value);
                  E := Create_Temp_Init
                    (T_Info.Ortho_Ptr_Type (Mode_Value), Val);
                  Copy_Fat_Access (T, E, Target_Type);
               end;
            when Type_Mode_Fat_Array =>
               declare
                  T : Mnode;
                  E : O_Dnode;
               begin
                  T := Stabilize (Target);
                  E := Create_Temp_Init
                    (T_Info.Ortho_Ptr_Type (Mode_Value), Val);
                  Chap3.Check_Array_Match
                    (Target_Type, T,
                     Get_Type (Expr), Dp2M (E, T_Info, Mode_Value), Loc);
                  Chap3.Translate_Object_Copy
                    (T, New_Obj_Value (E), Target_Type);
               end;
            when Type_Mode_Array =>
               --  Source is of type TARGET_TYPE, so no length check is
               --  necessary.
               Chap3.Translate_Object_Copy (Target, Val, Target_Type);
            when Type_Mode_Record =>
               Chap3.Translate_Object_Copy (Target, Val, Target_Type);
            when Type_Mode_Unknown
              | Type_Mode_Protected =>
               raise Internal_Error;
         end case;
      end Translate_Assign;

      procedure Translate_Assign
        (Target : Mnode; Expr : Iir; Target_Type : Iir)
      is
         Val : O_Enode;
      begin
         if Get_Kind (Expr) = Iir_Kind_Aggregate then
            --  FIXME: handle overlap between TARGET and EXPR.
            Translate_Aggregate (Target, Target_Type, Expr);
         else
            Open_Temp;
            Val := Chap7.Translate_Expression (Expr, Target_Type);
            Translate_Assign (Target, Val, Expr, Target_Type, Expr);
            Close_Temp;
         end if;
      end Translate_Assign;

      --  If AGGR is of the form (others => (others => EXPR)) (where the
      --   number of (others => ) sub-aggregate is at least 1, return EXPR
      --   otherwise return NULL_IIR.
      function Is_Aggregate_Others (Aggr : Iir_Aggregate) return Iir
      is
         Chain : Iir;
         Aggr1 : Iir;
         --Type_Info : Type_Info_Acc;
      begin
         Aggr1 := Aggr;
         --  Do not use translate_aggregate_others for a complex type.
         --Type_Info := Get_Info (Get_Type (Aggr));
         --if Type_Info.C /= null and then Type_Info.C.Builder_Need_Func then
         --   return Null_Iir;
         --end if;
         loop
            Chain := Get_Association_Choices_Chain (Aggr1);
            if not Is_Chain_Length_One (Chain) then
               return Null_Iir;
            end if;
            if Get_Kind (Chain) /= Iir_Kind_Choice_By_Others then
               return Null_Iir;
            end if;
            Aggr1 := Get_Associated (Chain);
            case Get_Kind (Aggr1) is
               when Iir_Kind_Aggregate =>
                  if Get_Type (Aggr1) /= Null_Iir then
                     --  Stop when a sub-aggregate is in fact an aggregate.
                     return Aggr1;
                  end if;
               when Iir_Kind_String_Literal
                 | Iir_Kind_Bit_String_Literal =>
                  return Null_Iir;
                  --Error_Kind ("is_aggregate_others", Aggr1);
               when others =>
                  return Aggr1;
            end case;
         end loop;
      end Is_Aggregate_Others;

      --  Generate code for (others => EL).
      procedure Translate_Aggregate_Others
        (Target : Mnode; Target_Type : Iir; El : Iir)
      is
         Base_Ptr : Mnode;
         Info : Type_Info_Acc;
         It : O_Dnode;
         Len : O_Dnode;
         Len_Val : O_Enode;
         Label : O_Snode;
         Arr_Var : Mnode;
         El_Node : Mnode;
      begin
         Open_Temp;

         Info := Get_Info (Target_Type);
         case Info.Type_Mode is
            when Type_Mode_Fat_Array =>
               Arr_Var := Stabilize (Target);
               Base_Ptr := Stabilize (Chap3.Get_Array_Base (Arr_Var));
               Len_Val := Chap3.Get_Array_Length (Arr_Var, Target_Type);
            when Type_Mode_Array =>
               Base_Ptr := Stabilize (Chap3.Get_Array_Base (Target));
               Len_Val := Chap3.Get_Array_Type_Length (Target_Type);
            when others =>
               raise Internal_Error;
         end case;
         --  FIXME: use this (since this use one variable instead of two):
         --  I := length;
         --  loop
         --    exit when I = 0;
         --    I := I - 1;
         --    A[I] := xxx;
         --  end loop;
         Len := Create_Temp_Init (Ghdl_Index_Type, Len_Val);
         if True then
            It := Create_Temp (Ghdl_Index_Type);
         else
            New_Var_Decl (It, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         end if;
         Init_Var (It);
         Start_Loop_Stmt (Label);
         Gen_Exit_When
           (Label, New_Compare_Op (ON_Eq,
                                   New_Obj_Value (It), New_Obj_Value (Len),
                                   Ghdl_Bool_Type));
         El_Node := Chap3.Index_Base (Base_Ptr, Target_Type,
                                      New_Obj_Value (It));
         --New_Assign_Stmt (El_Node, Chap7.Translate_Expression (El));
         Translate_Assign (El_Node, El, Get_Element_Subtype (Target_Type));
         Inc_Var (It);
         Finish_Loop_Stmt (Label);

         Close_Temp;
      end Translate_Aggregate_Others;

      procedure Translate_Array_Aggregate_Gen
        (Base_Ptr : Mnode;
         Bounds_Ptr : Mnode;
         Aggr : Iir;
         Aggr_Type : Iir;
         Dim : Natural;
         Var_Index : O_Dnode)
      is
         Index_List : Iir_List;
         Expr_Type : Iir;
         Final : Boolean;

         procedure Do_Assign (Expr : Iir)
         is
         begin
            if Final then
               Translate_Assign (Chap3.Index_Base (Base_Ptr, Aggr_Type,
                                                   New_Obj_Value (Var_Index)),
                                 Expr, Expr_Type);
               Inc_Var (Var_Index);
            else
               Translate_Array_Aggregate_Gen
                 (Base_Ptr, Bounds_Ptr, Expr, Aggr_Type, Dim + 1, Var_Index);
            end if;
         end Do_Assign;

         P : Natural;
         El : Iir;
      begin
         case Get_Kind (Aggr) is
            when Iir_Kind_Aggregate =>
               --  Continue below.
               null;
            when Iir_Kind_String_Literal
              | Iir_Kind_Bit_String_Literal =>
               declare
                  Len : constant Nat32 := Get_String_Length (Aggr);

                  --  Type of the unconstrained array type.
                  Arr_Type : O_Tnode;

                  --  Type of the constrained array type.
                  Str_Type : O_Tnode;

                  Cst : Var_Acc;
                  Var_I : O_Dnode;
                  Label : O_Snode;
               begin
                  Expr_Type := Get_Element_Subtype (Aggr_Type);

                  --  Create a constant for the string.
                  --  First, create its type, because the literal has no
                  --  type (subaggregate).
                  Arr_Type := New_Array_Type
                    (Get_Ortho_Type (Expr_Type, Mode_Value),
                     Ghdl_Index_Type);
                  New_Type_Decl (Create_Uniq_Identifier, Arr_Type);
                  Str_Type := New_Constrained_Array_Type
                    (Arr_Type, New_Index_Lit (Unsigned_64 (Len)));
                  Cst := Create_String_Literal_Var_Inner
                    (Aggr, Expr_Type, Str_Type);

                  --  Copy it.
                  Open_Temp;
                  Var_I := Create_Temp (Ghdl_Index_Type);
                  Init_Var (Var_I);
                  Start_Loop_Stmt (Label);
                  Gen_Exit_When
                    (Label,
                     New_Compare_Op (ON_Eq,
                                     New_Obj_Value (Var_I),
                                     New_Lit (New_Index_Lit (Nat32'Pos (Len))),
                                     Ghdl_Bool_Type));
                  New_Assign_Stmt
                    (M2Lv (Chap3.Index_Base (Base_Ptr, Aggr_Type,
                                             New_Obj_Value (Var_Index))),
                     New_Value (New_Indexed_Element (Get_Var (Cst),
                                                     New_Obj_Value (Var_I))));
                  Inc_Var (Var_I);
                  Inc_Var (Var_Index);
                  Finish_Loop_Stmt (Label);
                  Close_Temp;
                  Free_Var (Cst);
               end;
               return;
            when others =>
               raise Internal_Error;
         end case;

         Index_List := Get_Index_Subtype_List (Aggr_Type);

         --  FINAL is true if the elements of the aggregate are elements of
         --  the array.
         if Get_Nbr_Elements (Index_List) = Dim then
            Expr_Type := Get_Element_Subtype (Aggr_Type);
            Final:= True;
         else
            Final := False;
         end if;

         El := Get_Association_Choices_Chain (Aggr);

         --  First, assign positionnal association.
         --  FIXME: count the number of positionnal association and generate
         --   an error if there is more positionnal association than elements
         --   in the array.
         P := 0;
         loop
            if El = Null_Iir then
               --  There is only positionnal associations.
               return;
            end if;
            exit when Get_Kind (El) /= Iir_Kind_Choice_By_None;
            Do_Assign (Get_Associated (El));
            P := P + 1;
            El := Get_Chain (El);
         end loop;

         --  Then, assign named or others association.
         if Get_Chain (El) = Null_Iir then
            --  There is only one choice
            case Get_Kind (El) is
               when Iir_Kind_Choice_By_Others =>
                  --  falltrough...
                  null;
               when Iir_Kind_Choice_By_Expression =>
                  Do_Assign (Get_Associated (El));
                  return;
               when Iir_Kind_Choice_By_Range =>
                  declare
                     Var_Length : O_Dnode;
                     Var_I : O_Dnode;
                     Label : O_Snode;
                  begin
                     Open_Temp;
                     Var_Length := Create_Temp_Init
                       (Ghdl_Index_Type,
                        Chap7.Translate_Range_Length (Get_Expression (El)));
                     Var_I := Create_Temp (Ghdl_Index_Type);
                     Init_Var (Var_I);
                     Start_Loop_Stmt (Label);
                     Gen_Exit_When (Label,
                                    New_Compare_Op (ON_Eq,
                                                    New_Obj_Value (Var_I),
                                                    New_Obj_Value (Var_Length),
                                                    Ghdl_Bool_Type));
                     Do_Assign (Get_Associated (El));
                     Inc_Var (Var_I);
                     Finish_Loop_Stmt (Label);
                     Close_Temp;
                  end;
                  return;
               when others =>
                  Error_Kind ("translate_array_aggregate_gen", El);
            end case;
         end if;

         --  Several choices..
         declare
            Range_Type : Iir;
            Var_Pos : O_Dnode;
            Var_Len : O_Dnode;
            Range_Ptr : Mnode;
            Rtinfo : Type_Info_Acc;
            If_Blk : O_If_Block;
            Case_Blk : O_Case_Block;
            Label : O_Snode;
            El_Assoc : Iir;
            Len_Tmp : O_Enode;
         begin
            Open_Temp;
            --  Create a loop from left +- number of positionnals associations
            --   to/downto right.
            Range_Type :=
              Get_Base_Type (Get_Nth_Element (Index_List, Dim - 1));
            Rtinfo := Get_Info (Range_Type);
            Var_Pos := Create_Temp (Rtinfo.Ortho_Type (Mode_Value));
            Range_Ptr := Stabilize
              (Chap3.Bounds_To_Range (Bounds_Ptr, Aggr_Type, Dim));
            New_Assign_Stmt (New_Obj (Var_Pos),
                             M2E (Chap3.Range_To_Left (Range_Ptr)));
            Var_Len := Create_Temp (Ghdl_Index_Type);
            if P /= 0 then
               Start_If_Stmt
                 (If_Blk,
                  New_Compare_Op (ON_Eq,
                                  M2E (Chap3.Range_To_Dir (Range_Ptr)),
                                  New_Lit (Ghdl_Dir_To_Node),
                                  Ghdl_Bool_Type));
               Chap8.Gen_Update_Iterator (Var_Pos, Iir_To, Unsigned_64 (P),
                                          Range_Type);
               New_Else_Stmt (If_Blk);
               Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (P),
                                          Range_Type);
               Finish_If_Stmt (If_Blk);
            end if;

            Len_Tmp := M2E (Chap3.Range_To_Length (Range_Ptr));
            if P /= 0 then
               Len_Tmp := New_Dyadic_Op
                 (ON_Sub_Ov,
                  Len_Tmp,
                  New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
                                                 Unsigned_64 (P))));
            end if;
            New_Assign_Stmt (New_Obj (Var_Len), Len_Tmp);

            --  Start loop.
            Start_Loop_Stmt (Label);
            --  Check if end of loop.
            Gen_Exit_When
              (Label,
               New_Compare_Op (ON_Eq,
                               New_Obj_Value (Var_Len),
                               New_Lit (Ghdl_Index_0),
                               Ghdl_Bool_Type));

            --  convert aggr into a case statement.
            Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Pos));
            El_Assoc := Null_Iir;
            while El /= Null_Iir loop
               Start_Choice (Case_Blk);
               Chap8.Translate_Case_Choice (El, Range_Type, Case_Blk);
               if Get_Associated (El) /= Null_Iir then
                  El_Assoc := Get_Associated (El);
               end if;
               Finish_Choice (Case_Blk);
               Do_Assign (El_Assoc);
               P := P + 1;
               El := Get_Chain (El);
            end loop;
            Finish_Case_Stmt (Case_Blk);
            --  Update var_pos
            Start_If_Stmt
              (If_Blk,
               New_Compare_Op (ON_Eq,
                               M2E (Chap3.Range_To_Dir (Range_Ptr)),
                               New_Lit (Ghdl_Dir_To_Node),
                               Ghdl_Bool_Type));
            Chap8.Gen_Update_Iterator (Var_Pos, Iir_To, Unsigned_64 (1),
                                       Range_Type);
            New_Else_Stmt (If_Blk);
            Chap8.Gen_Update_Iterator (Var_Pos, Iir_Downto, Unsigned_64 (1),
                                       Range_Type);
            Finish_If_Stmt (If_Blk);
            New_Assign_Stmt
              (New_Obj (Var_Len),
               New_Dyadic_Op (ON_Sub_Ov,
                              New_Obj_Value (Var_Len),
                              New_Lit (Ghdl_Index_1)));
            Finish_Loop_Stmt (Label);
            Close_Temp;
         end;
      end Translate_Array_Aggregate_Gen;

      procedure Translate_Record_Aggregate (Target : Mnode; Aggr : Iir)
      is
         Targ : Mnode;
         Aggr_Type : constant Iir := Get_Type (Aggr);
         Aggr_Base_Type : constant Iir_Record_Type_Definition :=
           Get_Base_Type (Aggr_Type);
         El_List : constant Iir_List :=
           Get_Elements_Declaration_List (Aggr_Base_Type);
         El_Index : Natural;
         Nbr_El : constant Natural := Get_Nbr_Elements (El_List);

         --  Record which elements of the record have been set.  The 'others'
         --  clause applies to all elements not already set.
         type Bool_Array_Type is array (0 .. Nbr_El - 1) of Boolean;
         pragma Pack (Bool_Array_Type);
         Set_Array : Bool_Array_Type := (others => False);

         --  The expression associated.
         El_Expr : Iir;

         --  Set an elements.
         procedure Set_El (El : Iir_Element_Declaration) is
         begin
            Translate_Assign (Chap6.Translate_Selected_Element (Targ, El),
                              El_Expr, Get_Type (El));
            Set_Array (Natural (Get_Element_Position (El))) := True;
         end Set_El;

         Assoc : Iir;
         N_El_Expr : Iir;
      begin
         Open_Temp;
         Targ := Stabilize (Target);
         El_Index := 0;
         Assoc := Get_Association_Choices_Chain (Aggr);
         while Assoc /= Null_Iir loop
            N_El_Expr := Get_Associated (Assoc);
            if N_El_Expr /= Null_Iir then
               El_Expr := N_El_Expr;
            end if;
            case Get_Kind (Assoc) is
               when Iir_Kind_Choice_By_None =>
                  Set_El (Get_Nth_Element (El_List, El_Index));
                  El_Index := El_Index + 1;
               when Iir_Kind_Choice_By_Name =>
                  Set_El (Get_Name (Assoc));
                  El_Index := Natural'Last;
               when Iir_Kind_Choice_By_Others =>
                  for J in Set_Array'Range loop
                     if not Set_Array (J) then
                        Set_El (Get_Nth_Element (El_List, J));
                     end if;
                  end loop;
               when others =>
                  Error_Kind ("translate_record_aggregate", Assoc);
            end case;
            Assoc := Get_Chain (Assoc);
         end loop;
         Close_Temp;
      end Translate_Record_Aggregate;

      procedure Translate_Array_Aggregate
        (Target : Mnode; Target_Type : Iir; Aggr : Iir)
      is
         Aggr_Type : Iir;
         Base : Mnode;
         Bounds : Mnode;
         Var_Index : O_Dnode;
         Targ : Mnode;

         Rinfo : Type_Info_Acc;
         Bt : Iir;

         --  Generate code for: (LVAL lop RNG.left) or (RVAL rop RNG.right)
         function Check_Value (Lval : Iir;
                               Lop : ON_Op_Kind;
                               Rval : Iir;
                               Rop : ON_Op_Kind;
                               Rng : Mnode)
                              return O_Enode
         is
            L, R : O_Enode;
         begin
            L := New_Compare_Op
              (Lop,
               New_Lit (Translate_Static_Expression (Lval, Bt)),
               M2E (Chap3.Range_To_Left (Rng)),
               Ghdl_Bool_Type);
            R := New_Compare_Op
              (Rop,
               New_Lit (Translate_Static_Expression (Rval, Bt)),
               M2E (Chap3.Range_To_Right (Rng)),
               Ghdl_Bool_Type);
            return New_Dyadic_Op (ON_Or, L, R);
         end Check_Value;

         Range_Ptr : Mnode;
         Index_List : Iir_List;
         Targ_Index_List : Iir_List;
         Subtarg_Type : Iir;
         Subaggr_Type : Iir;
         L, H : Iir;
         Min : Iir_Int32;
         Has_Others : Boolean;

         Aggr_Info : Iir_Aggregate_Info;

         Var_Err : O_Dnode;
         E : O_Enode;
         If_Blk : O_If_Block;
         Op : ON_Op_Kind;
      begin
         Open_Temp;
         Targ := Stabilize (Target);
         Base := Stabilize (Chap3.Get_Array_Base (Targ));
         Bounds := Stabilize (Chap3.Get_Array_Bounds (Targ));

         --  Check type
         Aggr_Type := Get_Type (Aggr);
         Index_List := Get_Index_Subtype_List (Aggr_Type);
         Targ_Index_List := Get_Index_Subtype_List (Target_Type);
         Aggr_Info := Get_Aggregate_Info (Aggr);
         for I in Natural loop
            Subaggr_Type := Get_Index_Type (Index_List, I);
            exit when Subaggr_Type = Null_Iir;
            Subtarg_Type := Get_Index_Type (Targ_Index_List, I);

            Bt := Get_Base_Type (Subaggr_Type);
            Rinfo := Get_Info (Bt);

            if Get_Aggr_Dynamic_Flag (Aggr_Info) then
               --  Dynamic range, must evaluate it.
               Open_Temp;
               declare
                  A_Range : O_Dnode;
                  Rng_Ptr : O_Dnode;
               begin
                  --  Evaluate the range.
                  Chap3.Translate_Anonymous_Type_Definition
                    (Subaggr_Type, True);

                  A_Range := Create_Temp (Rinfo.T.Range_Type);
                  Rng_Ptr := Create_Temp_Ptr
                    (Rinfo.T.Range_Ptr_Type, New_Obj (A_Range));
                  Chap7.Translate_Range_Ptr
                    (Rng_Ptr,
                     Get_Range_Constraint (Subaggr_Type),
                     Subaggr_Type);

                  --  Check range length VS target length.
                  Chap6.Check_Bound_Error
                    (New_Compare_Op
                       (ON_Neq,
                        M2E (Chap3.Range_To_Length
                               (Dv2M (A_Range,
                                      Rinfo,
                                      Mode_Value,
                                      Rinfo.T.Range_Type,
                                      Rinfo.T.Range_Ptr_Type))),
                        M2E (Chap3.Range_To_Length
                               (Chap3.Bounds_To_Range
                                  (Bounds, Target_Type, I + 1))),
                        Ghdl_Bool_Type),
                     Aggr, I);
               end;
               Close_Temp;
            elsif Get_Type_Staticness (Subaggr_Type) /= Locally
              or else Subaggr_Type /= Subtarg_Type
            then
               --  Note: if the aggregate has no others, then the bounds
               --  must be the same, otherwise, aggregate bounds must be
               --  inside type bounds.
               Has_Others := Get_Aggr_Others_Flag (Aggr_Info);
               Min := Get_Aggr_Min_Length (Aggr_Info);
               L := Get_Aggr_Low_Limit (Aggr_Info);

               if Min > 0 or L /= Null_Iir then
                  Open_Temp;

                  --  Pointer to the range.
                  Range_Ptr := Stabilize
                    (Chap3.Bounds_To_Range (Bounds, Target_Type, I + 1));
                  Var_Err := Create_Temp (Ghdl_Bool_Type);
                  H := Get_Aggr_High_Limit (Aggr_Info);

                  if L /= Null_Iir then
                     --  Check the index range of the aggregrate is equal
                     --  (or within in presence of 'others') the index range
                     --  of the target.
                     Start_If_Stmt
                       (If_Blk,
                        New_Compare_Op (ON_Eq,
                                        M2E (Chap3.Range_To_Dir (Range_Ptr)),
                                        New_Lit (Ghdl_Dir_To_Node),
                                        Ghdl_Bool_Type));
                     if Has_Others then
                        E := Check_Value (L, ON_Lt, H, ON_Gt, Range_Ptr);
                     else
                        E := Check_Value (L, ON_Neq, H, ON_Neq, Range_Ptr);
                     end if;
                     New_Assign_Stmt (New_Obj (Var_Err), E);
                     New_Else_Stmt (If_Blk);
                     if Has_Others then
                        E := Check_Value (H, ON_Gt, L, ON_Lt, Range_Ptr);
                     else
                        E := Check_Value (H, ON_Neq, L, ON_Neq, Range_Ptr);
                     end if;
                     New_Assign_Stmt (New_Obj (Var_Err), E);
                     Finish_If_Stmt (If_Blk);
                     -- If L and H are greather than the minimum length,
                     -- then there is no need to check with min.
                     if Iir_Int32 (Eval_Pos (H) - Eval_Pos (L) + 1) >= Min then
                        Min := 0;
                     end if;
                  end if;

                  if Min > 0 then
                     --  Check the number of elements is equal (or less in
                     --  presence of 'others') than the length of the index
                     --  range of the target.
                     if Has_Others then
                        Op := ON_Lt;
                     else
                        Op := ON_Neq;
                     end if;
                     E := New_Compare_Op
                       (Op,
                        M2E (Chap3.Range_To_Length (Range_Ptr)),
                        New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
                                                       Unsigned_64 (Min))),
                        Ghdl_Bool_Type);
                     if L /= Null_Iir then
                        E := New_Dyadic_Op (ON_Or, E, New_Obj_Value (Var_Err));
                     end if;
                     New_Assign_Stmt (New_Obj (Var_Err), E);
                  end if;
                  Chap6.Check_Bound_Error (New_Obj_Value (Var_Err), Aggr, I);
                  Close_Temp;
               end if;
            end if;

            --  Next dimension.
            Aggr_Info := Get_Sub_Aggregate_Info (Aggr_Info);
         end loop;

         Var_Index := Create_Temp_Init
           (Ghdl_Index_Type, New_Lit (Ghdl_Index_0));
         Translate_Array_Aggregate_Gen
           (Base, Bounds, Aggr, Aggr_Type, 1, Var_Index);
         Close_Temp;

         --  FIXME: creating aggregate subtype is expensive and rarely used.
         --  (one of the current use - only ? - is check_array_match).
         Chap3.Translate_Anonymous_Type_Definition (Aggr_Type, False);
      end Translate_Array_Aggregate;

      procedure Translate_Aggregate
        (Target : Mnode; Target_Type : Iir; Aggr : Iir)
      is
         Aggr_Type : Iir;
         El : Iir;
      begin
         Aggr_Type := Get_Type (Aggr);
         case Get_Kind (Aggr_Type) is
            when Iir_Kind_Array_Subtype_Definition
              | Iir_Kind_Array_Type_Definition =>
               El := Is_Aggregate_Others (Aggr);
               if El /= Null_Iir then
                  Translate_Aggregate_Others (Target, Target_Type, El);
               else
                  Translate_Array_Aggregate (Target, Target_Type, Aggr);
               end if;
            when Iir_Kind_Record_Type_Definition
              | Iir_Kind_Record_Subtype_Definition =>
               Translate_Record_Aggregate (Target, Aggr);
            when others =>
               Error_Kind ("translate_aggregate", Aggr_Type);
         end case;
      end Translate_Aggregate;

      function Translate_Allocator_By_Expression (Expr : Iir)
        return O_Enode
      is
         Val : O_Enode;
         Val_M : Mnode;
         A_Type : constant Iir := Get_Type (Expr);
         A_Info : constant Type_Info_Acc := Get_Info (A_Type);
         D_Type : constant Iir := Get_Designated_Type (A_Type);
         D_Info : constant Type_Info_Acc := Get_Info (D_Type);
         R : Mnode;
         Rtype : O_Tnode;
      begin
         --  Compute the expression.
         Val := Translate_Expression (Get_Expression (Expr), D_Type);
         --  Allocate memory for the object.
         case A_Info.Type_Mode is
            when Type_Mode_Fat_Acc =>
               R := Dv2M (Create_Temp (D_Info.Ortho_Type (Mode_Value)),
                          D_Info, Mode_Value);
               Val_M := Stabilize (E2M (Val, D_Info, Mode_Value));
               Chap3.Translate_Object_Allocation
                 (R, Alloc_Heap, D_Type,
                  M2Addr (Chap3.Get_Array_Bounds (Val_M)));
               Val := M2E (Val_M);
               Rtype := A_Info.Ortho_Ptr_Type (Mode_Value);
            when Type_Mode_Acc =>
               R := Dp2M (Create_Temp (D_Info.Ortho_Ptr_Type (Mode_Value)),
                          D_Info, Mode_Value);
               Chap3.Translate_Object_Allocation
                 (R, Alloc_Heap, D_Type, O_Enode_Null);
               Rtype := A_Info.Ortho_Type (Mode_Value);
            when others =>
               raise Internal_Error;
         end case;
         Chap3.Translate_Object_Copy (R, Val, D_Type);
         return New_Convert_Ov (M2Addr (R), Rtype);
      end Translate_Allocator_By_Expression;

      function Translate_Allocator_By_Subtype (Expr : Iir)
        return O_Enode
      is
         P_Type : constant Iir := Get_Type (Expr);
         P_Info : constant Type_Info_Acc := Get_Info (P_Type);
         D_Type : constant Iir := Get_Designated_Type (P_Type);
         D_Info : constant Type_Info_Acc := Get_Info (D_Type);
         Sub_Type : Iir;
         Bounds : O_Enode;
         Res : Mnode;
         Rtype : O_Tnode;
      begin
         case P_Info.Type_Mode is
            when Type_Mode_Fat_Acc =>
               Res := Dv2M (Create_Temp (D_Info.Ortho_Type (Mode_Value)),
                            D_Info, Mode_Value);
               --  FIXME: should allocate bounds, and directly set bounds
               --  from the range.
               Sub_Type := Get_Subtype_Indication (Expr);
               Sub_Type := Get_Type_Of_Subtype_Indication (Sub_Type);
               Chap3.Create_Array_Subtype (Sub_Type, True);
               Bounds := M2E (Chap3.Get_Array_Type_Bounds (Sub_Type));
               Rtype := P_Info.Ortho_Ptr_Type (Mode_Value);
            when Type_Mode_Acc =>
               Res := Dp2M (Create_Temp (D_Info.Ortho_Ptr_Type (Mode_Value)),
                            D_Info, Mode_Value);
               Bounds := O_Enode_Null;
               Rtype := P_Info.Ortho_Type (Mode_Value);
            when others =>
               raise Internal_Error;
         end case;
         Chap3.Translate_Object_Allocation (Res, Alloc_Heap, D_Type, Bounds);
         Chap4.Init_Object (Res, D_Type);
         return New_Convert_Ov (M2Addr (Res), Rtype);
      end Translate_Allocator_By_Subtype;

      function Translate_Fat_Array_Type_Conversion
        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
        return O_Enode;

      function Translate_Array_Subtype_Conversion
        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
        return O_Enode
      is
         Res_Info : constant Type_Info_Acc := Get_Info (Res_Type);
         Expr_Info : constant Type_Info_Acc := Get_Info (Expr_Type);
      begin
         case Res_Info.Type_Mode is
            when Type_Mode_Array =>
               declare
                  E : O_Dnode;
               begin
                  E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value),
                                         Expr);
                  Chap3.Check_Array_Match
                    (Res_Type, T2M (Res_Type, Mode_Value),
                     Expr_Type, Dp2M (E, Expr_Info, Mode_Value),
                     Loc);
                  return New_Convert_Ov
                    (New_Value (Chap3.Get_Array_Ptr_Base_Ptr
                                (New_Obj (E), Expr_Type, Mode_Value)),
                     Res_Info.Ortho_Ptr_Type (Mode_Value));
               end;
            when Type_Mode_Fat_Array =>
               declare
                  Res : O_Dnode;
                  E : O_Dnode;
               begin
                  Res := Create_Temp (Res_Info.Ortho_Type (Mode_Value));
                  Open_Temp;
                  E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value),
                                         Expr);
                  --  Convert base.
                  New_Assign_Stmt
                    (New_Selected_Element
                     (New_Obj (Res), Res_Info.T.Base_Field (Mode_Value)),
                     New_Value (Chap3.Get_Array_Ptr_Base_Ptr
                                (New_Obj (E), Expr_Type, Mode_Value)));
                  --  Copy subtype bounds.
                  New_Assign_Stmt
                    (New_Selected_Element
                     (New_Obj (Res), Res_Info.T.Bounds_Field (Mode_Value)),
                     Chap3.Get_Array_Bounds_Ptr (O_Lnode_Null, Expr_Type,
                                                 Mode_Value));
                  --  Check array match.
                  Chap3.Check_Array_Match
                    (Res_Type, Dv2M (Res, Res_Info, Mode_Value),
                     Expr_Type, Dp2M (E, Expr_Info, Mode_Value),
                     Loc);
                  Close_Temp;
                  return New_Address
                    (New_Obj (Res), Res_Info.Ortho_Ptr_Type (Mode_Value));
               end;
            when others =>
               Error_Kind ("translate_array_subtype_conversion", Res_Type);
         end case;
      end Translate_Array_Subtype_Conversion;

      function Translate_Type_Conversion
        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
        return O_Enode
      is
         Res_Info : constant Type_Info_Acc := Get_Info (Res_Type);
         Res : O_Enode;
      begin
         case Get_Kind (Res_Type) is
            when Iir_Kinds_Scalar_Type_Definition =>
               Res := New_Convert_Ov (Expr, Res_Info.Ortho_Type (Mode_Value));
               if Chap3.Need_Range_Check (Null_Iir, Res_Type) then
                  Res := Chap3.Insert_Scalar_Check
                    (Res, Null_Iir, Res_Type, Loc);
               end if;
               return Res;
            when Iir_Kinds_Array_Type_Definition =>
               if Get_Constraint_State (Res_Type) = Fully_Constrained then
                  return Translate_Array_Subtype_Conversion
                    (Expr, Expr_Type, Res_Type, Loc);
               else
                  return Translate_Fat_Array_Type_Conversion
                    (Expr, Expr_Type, Res_Type, Loc);
               end if;
            when Iir_Kind_Record_Type_Definition
              | Iir_Kind_Record_Subtype_Definition =>
               return Expr;
            when others =>
               Error_Kind ("translate_type_conversion", Res_Type);
         end case;
      end Translate_Type_Conversion;

      function Translate_Fat_Array_Type_Conversion
        (Expr : O_Enode; Expr_Type : Iir; Res_Type : Iir; Loc : Iir)
        return O_Enode
      is
         Res : O_Dnode;
         Res_Ptr : O_Dnode;
         E : O_Dnode;
         Bounds : O_Dnode;
         Res_Indexes : Iir_List;
         Expr_Indexes : Iir_List;
         R_El : Iir;
         E_El : Iir;
         Res_Info : Type_Info_Acc;
         Expr_Info : Type_Info_Acc;
      begin
         Res_Info := Get_Info (Res_Type);
         Expr_Info := Get_Info (Expr_Type);
         Res := Create_Temp (Res_Info.Ortho_Type (Mode_Value));
         Bounds := Create_Temp (Res_Info.T.Bounds_Type);
         Open_Temp;
         Res_Ptr := Create_Temp_Ptr
           (Res_Info.Ortho_Ptr_Type (Mode_Value), New_Obj (Res));
         E := Create_Temp_Init (Expr_Info.Ortho_Ptr_Type (Mode_Value), Expr);
         --  Set base.
         New_Assign_Stmt
           (New_Selected_Element (New_Obj (Res),
                                  Res_Info.T.Base_Field (Mode_Value)),
            New_Convert_Ov (New_Value (Chap3.Get_Array_Ptr_Base_Ptr
                                       (New_Obj (E), Expr_Type, Mode_Value)),
                            Res_Info.T.Base_Ptr_Type (Mode_Value)));
         --  Set bounds.
         New_Assign_Stmt
           (New_Selected_Element (New_Obj (Res),
                                  Res_Info.T.Bounds_Field (Mode_Value)),
            New_Address (New_Obj (Bounds), Res_Info.T.Bounds_Ptr_Type));
         --  Convert bounds.
         Res_Indexes := Get_Index_Subtype_List (Res_Type);
         Expr_Indexes := Get_Index_Subtype_List (Expr_Type);
         for I in Natural loop
            R_El := Get_Index_Type (Res_Indexes, I);
            E_El := Get_Index_Type (Expr_Indexes, I);
            exit when R_El = Null_Iir;
            declare
               Rb_Ptr : O_Dnode;
               Eb_Ptr : O_Dnode;
               Rr_Info : constant Type_Info_Acc := Get_Info (R_El);
               Er_Info : constant Type_Info_Acc :=
                 Get_Info (Get_Base_Type (E_El));
            begin
               Open_Temp;
               Rb_Ptr := Create_Temp_Init
                 (Rr_Info.T.Range_Ptr_Type,
                  Chap3.Get_Array_Ptr_Range_Ptr (New_Obj (Res_Ptr),
                                                 Res_Type, I + 1,
                                                 Mode_Value));
               Eb_Ptr := Create_Temp_Init
                 (Er_Info.T.Range_Ptr_Type,
                  Chap3.Get_Array_Ptr_Range_Ptr (New_Obj (E), Expr_Type, I + 1,
                                                 Mode_Value));
               --  Convert left and right.
               New_Assign_Stmt
                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
                                          Rr_Info.T.Range_Left),
                  Translate_Type_Conversion
                  (New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
                                                 Er_Info.T.Range_Left),
                   E_El, R_El, Loc));
               New_Assign_Stmt
                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
                                          Rr_Info.T.Range_Right),
                  Translate_Type_Conversion
                  (New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
                                                 Er_Info.T.Range_Right),
                   E_El, R_El, Loc));
               --  Copy Dir and Length.
               New_Assign_Stmt
                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
                                          Rr_Info.T.Range_Dir),
                  New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
                                                Er_Info.T.Range_Dir));
               New_Assign_Stmt
                 (New_Selected_Acc_Value (New_Obj (Rb_Ptr),
                                          Rr_Info.T.Range_Length),
                  New_Value_Selected_Acc_Value (New_Obj (Eb_Ptr),
                                                Er_Info.T.Range_Length));
               Close_Temp;
            end;
         end loop;
         Close_Temp;
         return New_Address (New_Obj (Res),
                             Res_Info.Ortho_Ptr_Type (Mode_Value));
      end Translate_Fat_Array_Type_Conversion;

      function Sig2val_Prepare_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Mnode)
        return Mnode
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         if Get_Type_Info (Data).Type_Mode = Type_Mode_Fat_Array then
            return Stabilize (Chap3.Get_Array_Base (Data));
         else
            return Stabilize (Data);
         end if;
      end Sig2val_Prepare_Composite;

      function Sig2val_Update_Data_Array
        (Val : Mnode; Targ_Type : Iir; Index : O_Dnode) return Mnode
      is
      begin
         return Chap3.Index_Base (Val, Targ_Type, New_Obj_Value (Index));
      end Sig2val_Update_Data_Array;

      function Sig2val_Update_Data_Record
        (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
        return Mnode
      is
         pragma Unreferenced (Targ_Type);
      begin
         return Chap6.Translate_Selected_Element (Val, El);
      end Sig2val_Update_Data_Record;

      procedure Sig2val_Finish_Data_Composite (Data : in out Mnode)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Sig2val_Finish_Data_Composite;

      procedure Translate_Signal_Assign_Effective_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Mnode)
      is
         pragma Unreferenced (Targ_Type);
      begin
         New_Assign_Stmt (New_Access_Element (M2E (Targ)), M2E (Data));
      end Translate_Signal_Assign_Effective_Non_Composite;

      procedure Translate_Signal_Assign_Effective is new Foreach_Non_Composite
        (Data_Type => Mnode,
         Composite_Data_Type => Mnode,
         Do_Non_Composite => Translate_Signal_Assign_Effective_Non_Composite,
         Prepare_Data_Array => Sig2val_Prepare_Composite,
         Update_Data_Array => Sig2val_Update_Data_Array,
         Finish_Data_Array => Sig2val_Finish_Data_Composite,
         Prepare_Data_Record => Sig2val_Prepare_Composite,
         Update_Data_Record => Sig2val_Update_Data_Record,
         Finish_Data_Record => Sig2val_Finish_Data_Composite);

      procedure Translate_Signal_Assign_Driving_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Data: Mnode)
      is
      begin
         New_Assign_Stmt
           (Chap14.Get_Signal_Value_Field (M2E (Targ), Targ_Type,
                                           Ghdl_Signal_Driving_Value_Field),
            M2E (Data));
      end Translate_Signal_Assign_Driving_Non_Composite;

      procedure Translate_Signal_Assign_Driving is new Foreach_Non_Composite
        (Data_Type => Mnode,
         Composite_Data_Type => Mnode,
         Do_Non_Composite => Translate_Signal_Assign_Driving_Non_Composite,
         Prepare_Data_Array => Sig2val_Prepare_Composite,
         Update_Data_Array => Sig2val_Update_Data_Array,
         Finish_Data_Array => Sig2val_Finish_Data_Composite,
         Prepare_Data_Record => Sig2val_Prepare_Composite,
         Update_Data_Record => Sig2val_Update_Data_Record,
         Finish_Data_Record => Sig2val_Finish_Data_Composite);

      function Translate_Signal_Value (Sig : O_Enode; Sig_Type : Iir)
        return O_Enode
      is
         procedure Translate_Signal_Non_Composite
           (Targ : Mnode;
            Targ_Type : Iir;
            Data : Mnode)
         is
         begin
            New_Assign_Stmt (M2Lv (Targ),
                             Read_Value (M2E (Data), Targ_Type));
         end Translate_Signal_Non_Composite;

         procedure Translate_Signal_Target is new Foreach_Non_Composite
           (Data_Type => Mnode,
            Composite_Data_Type => Mnode,
            Do_Non_Composite => Translate_Signal_Non_Composite,
            Prepare_Data_Array => Sig2val_Prepare_Composite,
            Update_Data_Array => Sig2val_Update_Data_Array,
            Finish_Data_Array => Sig2val_Finish_Data_Composite,
            Prepare_Data_Record => Sig2val_Prepare_Composite,
            Update_Data_Record => Sig2val_Update_Data_Record,
            Finish_Data_Record => Sig2val_Finish_Data_Composite);

         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Info (Sig_Type);
         if Tinfo.Type_Mode in Type_Mode_Scalar then
            return Read_Value (Sig, Sig_Type);
         else
            declare
               Res : Mnode;
               Var_Val : Mnode;
            begin
               --  allocate result array
               if Tinfo.Type_Mode = Type_Mode_Fat_Array then
                  Res := Create_Temp (Tinfo);

                  Var_Val := Stabilize (E2M (Sig, Tinfo, Mode_Signal));

                  --  Copy bounds.
                  New_Assign_Stmt
                    (M2Lp (Chap3.Get_Array_Bounds (Res)),
                     M2Addr (Chap3.Get_Array_Bounds (Var_Val)));

                  --  Allocate base.
                  Chap3.Allocate_Fat_Array_Base (Alloc_Stack, Res, Sig_Type);
               elsif Is_Complex_Type (Tinfo) then
                  Res := Create_Temp (Tinfo);
                  Chap4.Allocate_Complex_Object (Sig_Type, Alloc_Stack, Res);
               else
                  Res := Create_Temp (Tinfo);
               end if;

               Open_Temp;

               if Tinfo.Type_Mode /= Type_Mode_Fat_Array then
                  Var_Val := Stabilize (E2M (Sig, Tinfo, Mode_Signal));
               end if;

               Translate_Signal_Target (Res, Sig_Type, Var_Val);
               Close_Temp;
               return M2Addr (Res);
            end;
         end if;
      end Translate_Signal_Value;

      --  Get the effective value of a simple signal SIG.
      function Read_Signal_Value (Sig : O_Enode; Sig_Type : Iir)
                                 return O_Enode
      is
         pragma Unreferenced (Sig_Type);
      begin
         return New_Value (New_Access_Element (Sig));
      end Read_Signal_Value;

      --  Get the value of signal SIG.
      function Translate_Signal is new Translate_Signal_Value
        (Read_Value => Read_Signal_Value);

      function Translate_Signal_Effective_Value
        (Sig : O_Enode; Sig_Type : Iir) return O_Enode
        renames Translate_Signal;

      function Read_Signal_Driving_Value (Sig : O_Enode; Sig_Type : Iir)
        return O_Enode is
      begin
         return New_Value (Chap14.Get_Signal_Value_Field
                           (Sig, Sig_Type, Ghdl_Signal_Driving_Value_Field));
      end Read_Signal_Driving_Value;

      function Translate_Signal_Driving_Value_1 is new Translate_Signal_Value
        (Read_Value => Read_Signal_Driving_Value);

      function Translate_Signal_Driving_Value
        (Sig : O_Enode; Sig_Type : Iir) return O_Enode
        renames Translate_Signal_Driving_Value_1;

      procedure Set_Effective_Value
        (Sig : Mnode; Sig_Type : Iir; Val : Mnode)
        renames Translate_Signal_Assign_Effective;
      procedure Set_Driving_Value
        (Sig : Mnode; Sig_Type : Iir; Val : Mnode)
        renames Translate_Signal_Assign_Driving;

      function Translate_Expression (Expr : Iir; Rtype : Iir := Null_Iir)
                                    return O_Enode
      is
         Imp : Iir;
         Expr_Type : Iir;
         Res_Type : Iir;
         Res : O_Enode;
      begin
         Expr_Type := Get_Type (Expr);
         if Rtype = Null_Iir then
            Res_Type := Expr_Type;
         else
            Res_Type := Rtype;
         end if;
         case Get_Kind (Expr) is
            when Iir_Kind_Integer_Literal
              | Iir_Kind_Enumeration_Literal
              | Iir_Kind_Floating_Point_Literal =>
               return New_Lit (Translate_Static_Expression (Expr, Rtype));

            when Iir_Kind_Physical_Int_Literal =>
               declare
                  Unit : Iir;
                  Unit_Info : Object_Info_Acc;
               begin
                  Unit := Get_Unit_Name (Expr);
                  Unit_Info := Get_Info (Unit);
                  if Unit_Info = null then
                     return New_Lit
                       (Translate_Static_Expression (Expr, Rtype));
                  else
                     --  Time units might be not locally static.
                     return New_Dyadic_Op
                       (ON_Mul_Ov,
                        New_Lit (New_Signed_Literal
                                 (Get_Ortho_Type (Expr_Type, Mode_Value),
                                  Integer_64 (Get_Value (Expr)))),
                        New_Value (Get_Var (Unit_Info.Object_Var)));
                  end if;
               end;

            when Iir_Kind_Physical_Fp_Literal =>
               declare
                  Unit : Iir;
                  Unit_Info : Object_Info_Acc;
                  L, R : O_Enode;
               begin
                  Unit := Get_Unit_Name (Expr);
                  Unit_Info := Get_Info (Unit);
                  if Unit_Info = null then
                     return New_Lit
                       (Translate_Static_Expression (Expr, Rtype));
                  else
                     --  Time units might be not locally static.
                     L := New_Lit
                       (New_Float_Literal
                        (Ghdl_Real_Type, IEEE_Float_64 (Get_Fp_Value (Expr))));
                     R := New_Convert_Ov
                       (New_Value (Get_Var (Unit_Info.Object_Var)),
                        Ghdl_Real_Type);
                     return New_Convert_Ov
                       (New_Dyadic_Op (ON_Mul_Ov, L, R),
                        Get_Ortho_Type (Expr_Type, Mode_Value));
                  end if;
               end;

            when Iir_Kind_Unit_Declaration =>
               declare
                  Unit_Info : Object_Info_Acc;
               begin
                  Unit_Info := Get_Info (Expr);
                  if Unit_Info = null then
                     return New_Lit
                       (Translate_Static_Expression (Expr, Rtype));
                  else
                     --  Time units might be not locally static.
                     return New_Value (Get_Var (Unit_Info.Object_Var));
                  end if;
               end;

            when Iir_Kind_String_Literal
              | Iir_Kind_Bit_String_Literal
              | Iir_Kind_Simple_Aggregate
              | Iir_Kind_Simple_Name_Attribute =>
               Res := Translate_String_Literal (Expr);

            when Iir_Kind_Aggregate =>
               declare
                  Aggr_Type : Iir;
                  Tinfo : Type_Info_Acc;
                  Mres : Mnode;
               begin
                  if Rtype = Null_Iir then
                     raise Internal_Error;
                  end if;

                  --  Extract the type of the aggregate.
                  if Get_Kind (Rtype) /= Iir_Kind_Array_Type_Definition then
                     Aggr_Type := Rtype;
                  else
                     Aggr_Type := Expr_Type;
                     if Get_Kind (Expr_Type)
                       = Iir_Kind_Array_Subtype_Definition
                     then
                        Chap3.Create_Array_Subtype (Expr_Type, True);
                     end if;
                  end if;

                  --  FIXME: this may be not necessary
                  Tinfo := Get_Info (Aggr_Type);

                  --  The result area has to be created
                  if Is_Complex_Type (Tinfo) then
                     Mres := Create_Temp (Tinfo);
                     Chap4.Allocate_Complex_Object
                       (Aggr_Type, Alloc_Stack, Mres);
                  else
                     --  if thin array/record:
                     --    create result
                     Mres := Create_Temp (Tinfo);
                  end if;

                  Translate_Aggregate (Mres, Aggr_Type, Expr);
                  Res := M2E (Mres);

                  if Aggr_Type /= Rtype then
                     Res := Translate_Implicit_Conv
                       (Res, Aggr_Type, Rtype, Mode_Value, Expr);
                  end if;
                  return Res;
               end;

            when Iir_Kind_Null_Literal =>
               declare
                  Tinfo : constant Type_Info_Acc := Get_Info (Expr_Type);
                  Otype : constant O_Tnode := Tinfo.Ortho_Type (Mode_Value);
                  L : O_Dnode;
                  B : Type_Info_Acc;
               begin
                  if Tinfo.Type_Mode = Type_Mode_Fat_Acc then
                     --  Create a fat null pointer.
                     --  FIXME: should be optimized!!
                     L := Create_Temp (Otype);
                     B := Get_Info (Get_Designated_Type (Expr_Type));
                     New_Assign_Stmt
                       (New_Selected_Element (New_Obj (L),
                                              B.T.Base_Field (Mode_Value)),
                        New_Lit
                        (New_Null_Access (B.T.Base_Ptr_Type (Mode_Value))));
                     New_Assign_Stmt
                       (New_Selected_Element
                        (New_Obj (L), B.T.Bounds_Field (Mode_Value)),
                        New_Lit (New_Null_Access (B.T.Bounds_Ptr_Type)));
                     return New_Address (New_Obj (L),
                                         Tinfo.Ortho_Ptr_Type (Mode_Value));
                  else
                     return New_Lit (New_Null_Access (Otype));
                  end if;
               end;

            when Iir_Kind_Overflow_Literal =>
               declare
                  Tinfo : constant Type_Info_Acc := Get_Info (Expr_Type);
                  Otype : constant O_Tnode := Tinfo.Ortho_Type (Mode_Value);
                  L : O_Dnode;
               begin
                  --  Generate the error message
                  Chap6.Gen_Bound_Error (Expr);

                  --  Create a dummy value
                  L := Create_Temp (Otype);
                  if Tinfo.Type_Mode = Type_Mode_Fat_Acc then
                     return New_Address (New_Obj (L),
                                         Tinfo.Ortho_Ptr_Type (Mode_Value));
                  else
                     return New_Obj_Value (L);
                  end if;
               end;

            when Iir_Kind_Parenthesis_Expression =>
               return Translate_Expression (Get_Expression (Expr), Rtype);

            when Iir_Kind_Allocator_By_Expression =>
               return Translate_Allocator_By_Expression (Expr);
            when Iir_Kind_Allocator_By_Subtype =>
               return Translate_Allocator_By_Subtype (Expr);

            when Iir_Kind_Qualified_Expression =>
               --  FIXME: check type.
               Res := Translate_Expression (Get_Expression (Expr), Expr_Type);

            when Iir_Kind_Constant_Declaration
              | Iir_Kind_Variable_Declaration
              | Iir_Kind_Signal_Declaration
              | Iir_Kind_File_Declaration
              | Iir_Kind_Object_Alias_Declaration
              | Iir_Kind_Constant_Interface_Declaration
              | Iir_Kind_Variable_Interface_Declaration
              | Iir_Kind_Signal_Interface_Declaration
              | Iir_Kind_File_Interface_Declaration
              | Iir_Kind_Indexed_Name
              | Iir_Kind_Slice_Name
              | Iir_Kind_Selected_Element
              | Iir_Kind_Dereference
              | Iir_Kind_Implicit_Dereference
              | Iir_Kind_Stable_Attribute
              | Iir_Kind_Quiet_Attribute
              | Iir_Kind_Delayed_Attribute
              | Iir_Kind_Transaction_Attribute
              | Iir_Kind_Guard_Signal_Declaration
              | Iir_Kind_Attribute_Value
              | Iir_Kind_Attribute_Name =>
               declare
                  L : Mnode;
               begin
                  L := Chap6.Translate_Name (Expr);

                  Res := M2E (L);
                  if Get_Object_Kind (L) = Mode_Signal then
                     Res := Translate_Signal (Res, Expr_Type);
                  end if;
               end;

            when Iir_Kind_Iterator_Declaration =>
               declare
                  Expr_Info : Ortho_Info_Acc;
               begin
                  Expr_Info := Get_Info (Expr);
                  Res := New_Value (Get_Var (Expr_Info.Iterator_Var));
                  if Rtype /= Null_Iir then
                     Res := New_Convert_Ov
                       (Res, Get_Ortho_Type (Rtype, Mode_Value));
                  end if;
                  return Res;
               end;

            when Iir_Kinds_Dyadic_Operator =>
               Imp := Get_Implementation (Expr);
               if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration then
                  return Translate_Predefined_Operator
                    (Imp, Get_Left (Expr), Get_Right (Expr), Res_Type, Expr);
               else
                  return Translate_Operator_Function_Call
                    (Imp, Get_Left (Expr), Get_Right (Expr), Res_Type);
               end if;
            when Iir_Kinds_Monadic_Operator =>
               Imp := Get_Implementation (Expr);
               if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration then
                  return Translate_Predefined_Operator
                    (Imp, Get_Operand (Expr), Null_Iir, Res_Type, Expr);
               else
                  return Translate_Operator_Function_Call
                    (Imp, Get_Operand (Expr), Null_Iir, Res_Type);
               end if;
            when Iir_Kind_Function_Call =>
               Imp := Get_Named_Entity (Get_Implementation (Expr));
               declare
                  Assoc_Chain : Iir;
               begin
                  if Get_Kind (Imp) = Iir_Kind_Implicit_Function_Declaration
                  then
                     declare
                        Left, Right : Iir;
                     begin
                        Assoc_Chain := Get_Parameter_Association_Chain (Expr);
                        if Assoc_Chain = Null_Iir then
                           Left := Null_Iir;
                           Right := Null_Iir;
                        else
                           Left := Get_Actual (Assoc_Chain);
                           Assoc_Chain := Get_Chain (Assoc_Chain);
                           if Assoc_Chain = Null_Iir then
                              Right := Null_Iir;
                           else
                              Right := Get_Actual (Assoc_Chain);
                           end if;
                        end if;
                        return Translate_Predefined_Operator
                          (Imp, Left, Right, Res_Type, Expr);
                     end;
                  else
                     Canon.Canon_Subprogram_Call (Expr);
                     Assoc_Chain := Get_Parameter_Association_Chain (Expr);
                     Res := Translate_Function_Call
                       (Imp, Assoc_Chain, Get_Method_Object (Expr));
                     Expr_Type := Get_Return_Type (Imp);
                  end if;
               end;

            when Iir_Kind_Type_Conversion =>
               declare
                  Conv_Expr : Iir;
               begin
                  Conv_Expr := Get_Expression (Expr);
                  Res := Translate_Type_Conversion
                    (Translate_Expression (Conv_Expr), Get_Type (Conv_Expr),
                     Expr_Type, Expr);
               end;

            when Iir_Kind_Length_Array_Attribute =>
               return Chap14.Translate_Length_Array_Attribute
                 (Expr, Res_Type);
            when Iir_Kind_Low_Array_Attribute =>
               return Chap14.Translate_Low_Array_Attribute (Expr);
            when Iir_Kind_High_Array_Attribute =>
               return Chap14.Translate_High_Array_Attribute (Expr);
            when Iir_Kind_Left_Array_Attribute =>
               return Chap14.Translate_Left_Array_Attribute (Expr);
            when Iir_Kind_Right_Array_Attribute =>
               return Chap14.Translate_Right_Array_Attribute (Expr);
            when Iir_Kind_Ascending_Array_Attribute =>
               return Chap14.Translate_Ascending_Array_Attribute (Expr);

            when Iir_Kind_Val_Attribute =>
               return Chap14.Translate_Val_Attribute (Expr);
            when Iir_Kind_Pos_Attribute =>
               return Chap14.Translate_Pos_Attribute (Expr, Res_Type);

            when Iir_Kind_Succ_Attribute
               | Iir_Kind_Pred_Attribute =>
               return Chap14.Translate_Succ_Pred_Attribute (Expr);

            when Iir_Kind_Image_Attribute =>
               Res := Chap14.Translate_Image_Attribute (Expr);

            when Iir_Kind_Value_Attribute =>
               return Chap14.Translate_Value_Attribute (Expr);

            when Iir_Kind_Event_Attribute =>
               return Chap14.Translate_Event_Attribute (Expr);
            when Iir_Kind_Active_Attribute =>
               return Chap14.Translate_Active_Attribute (Expr);
            when Iir_Kind_Last_Value_Attribute =>
               Res := Chap14.Translate_Last_Value_Attribute (Expr);

            when Iir_Kind_High_Type_Attribute =>
               return Chap14.Translate_High_Low_Type_Attribute (Expr, True);
            when Iir_Kind_Low_Type_Attribute =>
               return Chap14.Translate_High_Low_Type_Attribute (Expr, False);
            when Iir_Kind_Left_Type_Attribute =>
               return M2E
                 (Chap3.Range_To_Left
                    (Lv2M (Translate_Range (Get_Prefix (Expr), Expr_Type),
                           Get_Info (Get_Base_Type (Expr_Type)), Mode_Value)));
            when Iir_Kind_Right_Type_Attribute =>
               return M2E
                 (Chap3.Range_To_Right
                    (Lv2M (Translate_Range (Get_Prefix (Expr), Expr_Type),
                           Get_Info (Get_Base_Type (Expr_Type)), Mode_Value)));

            when Iir_Kind_Last_Event_Attribute =>
               return Chap14.Translate_Last_Time_Attribute
                 (Get_Prefix (Expr), Ghdl_Signal_Last_Event_Field);
            when Iir_Kind_Last_Active_Attribute =>
               return Chap14.Translate_Last_Time_Attribute
                 (Get_Prefix (Expr), Ghdl_Signal_Last_Active_Field);

            when Iir_Kind_Driving_Value_Attribute =>
               Res := Chap14.Translate_Driving_Value_Attribute (Expr);
            when Iir_Kind_Driving_Attribute =>
               Res := Chap14.Translate_Driving_Attribute (Expr);

            when Iir_Kind_Path_Name_Attribute
              | Iir_Kind_Instance_Name_Attribute =>
               Res := Chap14.Translate_Path_Instance_Name_Attribute (Expr);

            when Iir_Kind_Simple_Name
              | Iir_Kind_Character_Literal
              | Iir_Kind_Selected_Name =>
               return Translate_Expression (Get_Named_Entity (Expr), Rtype);

            when others =>
               Error_Kind ("translate_expression", Expr);
         end case;

         --  Quick test to avoid useless calls.
         if Expr_Type /= Res_Type then
            Res := Translate_Implicit_Conv
              (Res, Expr_Type, Res_Type, Mode_Value, Expr);
         end if;

         return Res;
      end Translate_Expression;

      --  Check if RNG is of the form:
      --     1 to T'length
      --  or T'Length downto 1
      --  or 0 to T'length - 1
      --  or T'Length - 1 downto 0
      --  In either of these cases, return T'Length
      function Is_Length_Range_Expression (Rng : Iir_Range_Expression)
                                          return Iir
      is
         --  Pattern of a bound.
         type Length_Pattern is
           (
            Pat_Unknown,
            Pat_Length,
            Pat_Length_1,  --  Length - 1
            Pat_1,
            Pat_0
           );
         Length_Attr : Iir := Null_Iir;

         --  Classify the bound.
         --  Set LENGTH_ATTR is the pattern is Pat_Length.
         function Get_Length_Pattern (Expr : Iir; Recurse : Boolean)
                                     return Length_Pattern
         is
         begin
            case Get_Kind (Expr) is
               when Iir_Kind_Length_Array_Attribute =>
                  Length_Attr := Expr;
                  return Pat_Length;
               when Iir_Kind_Integer_Literal =>
                  case Get_Value (Expr) is
                     when 0 =>
                        return Pat_0;
                     when 1 =>
                        return Pat_1;
                     when others =>
                        return Pat_Unknown;
                  end case;
               when Iir_Kind_Substraction_Operator =>
                  if not Recurse then
                     return Pat_Unknown;
                  end if;
                  if Get_Length_Pattern (Get_Left (Expr), False) = Pat_Length
                    and then
                    Get_Length_Pattern (Get_Right (Expr), False) = Pat_1
                  then
                     return Pat_Length_1;
                  else
                     return Pat_Unknown;
                  end if;
               when others =>
                  return Pat_Unknown;
            end case;
         end Get_Length_Pattern;
         Left_Pat, Right_Pat : Length_Pattern;
      begin
         Left_Pat := Get_Length_Pattern (Get_Left_Limit (Rng), True);
         if Left_Pat = Pat_Unknown then
            return Null_Iir;
         end if;
         Right_Pat := Get_Length_Pattern (Get_Right_Limit (Rng), True);
         if Right_Pat = Pat_Unknown then
            return Null_Iir;
         end if;
         case Get_Direction (Rng) is
            when Iir_To =>
               if (Left_Pat = Pat_1 and Right_Pat = Pat_Length)
                 or else (Left_Pat = Pat_0 and Right_Pat = Pat_Length_1)
               then
                  return Length_Attr;
               end if;
            when Iir_Downto =>
               if (Left_Pat = Pat_Length and Right_Pat = Pat_1)
                 or else (Left_Pat = Pat_Length_1 and Right_Pat = Pat_0)
               then
                  return Length_Attr;
               end if;
         end case;
         return Null_Iir;
      end Is_Length_Range_Expression;

      procedure Translate_Range_Expression_Ptr
        (Res_Ptr : O_Dnode; Expr : Iir; Range_Type : Iir)
      is
         T_Info : Type_Info_Acc;
         Length_Attr : Iir;
      begin
         T_Info := Get_Info (Range_Type);
         Open_Temp;
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), T_Info.T.Range_Left),
            Chap7.Translate_Range_Expression_Left (Expr, Range_Type));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), T_Info.T.Range_Right),
            Chap7.Translate_Range_Expression_Right (Expr, Range_Type));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), T_Info.T.Range_Dir),
            New_Lit (Chap7.Translate_Static_Range_Dir (Expr)));
         if T_Info.T.Range_Length /= O_Fnode_Null then
            if Get_Expr_Staticness (Expr) = Locally then
               New_Assign_Stmt
                 (New_Selected_Acc_Value (New_Obj (Res_Ptr),
                                          T_Info.T.Range_Length),
                  New_Lit (Translate_Static_Range_Length (Expr)));
            else
               Length_Attr := Is_Length_Range_Expression (Expr);
               if Length_Attr = Null_Iir then
                  Open_Temp;
                  New_Assign_Stmt
                    (New_Selected_Acc_Value (New_Obj (Res_Ptr),
                                             T_Info.T.Range_Length),
                     Compute_Range_Length
                     (New_Value_Selected_Acc_Value (New_Obj (Res_Ptr),
                                                    T_Info.T.Range_Left),
                      New_Value_Selected_Acc_Value (New_Obj (Res_Ptr),
                                                    T_Info.T.Range_Right),
                      Get_Direction (Expr)));
                  Close_Temp;
               else
                  New_Assign_Stmt
                    (New_Selected_Acc_Value (New_Obj (Res_Ptr),
                                             T_Info.T.Range_Length),
                     Chap14.Translate_Length_Array_Attribute
                     (Length_Attr, Null_Iir));
               end if;
            end if;
         end if;
         Close_Temp;
      end Translate_Range_Expression_Ptr;

      --  Reverse range ARANGE.
      procedure Translate_Reverse_Range_Ptr
        (Res_Ptr : O_Dnode; Arange : O_Lnode; Range_Type : Iir)
      is
         Rinfo : Type_Info_Acc;
         Ptr : O_Dnode;
         If_Blk : O_If_Block;
      begin
         Rinfo := Get_Info (Get_Base_Type (Range_Type));
         Open_Temp;
         Ptr := Create_Temp_Ptr (Rinfo.T.Range_Ptr_Type, Arange);
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), Rinfo.T.Range_Left),
            New_Value_Selected_Acc_Value (New_Obj (Ptr), Rinfo.T.Range_Right));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), Rinfo.T.Range_Right),
            New_Value_Selected_Acc_Value (New_Obj (Ptr), Rinfo.T.Range_Left));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), Rinfo.T.Range_Length),
            New_Value_Selected_Acc_Value (New_Obj (Ptr),
                                          Rinfo.T.Range_Length));
         Start_If_Stmt
           (If_Blk,
            New_Compare_Op
            (ON_Eq,
             New_Value_Selected_Acc_Value (New_Obj (Ptr), Rinfo.T.Range_Dir),
             New_Lit (Ghdl_Dir_To_Node),
             Ghdl_Bool_Type));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), Rinfo.T.Range_Dir),
            New_Lit (Ghdl_Dir_Downto_Node));
         New_Else_Stmt (If_Blk);
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Res_Ptr), Rinfo.T.Range_Dir),
            New_Lit (Ghdl_Dir_To_Node));
         Finish_If_Stmt (If_Blk);
         Close_Temp;
      end Translate_Reverse_Range_Ptr;

      procedure Copy_Range (Dest_Ptr : O_Dnode;
                            Src_Ptr : O_Dnode;
                            Info : Type_Info_Acc)
      is
      begin
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Dest_Ptr), Info.T.Range_Left),
            New_Value_Selected_Acc_Value (New_Obj (Src_Ptr),
                                          Info.T.Range_Left));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Dest_Ptr), Info.T.Range_Right),
            New_Value_Selected_Acc_Value (New_Obj (Src_Ptr),
                                          Info.T.Range_Right));
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Dest_Ptr), Info.T.Range_Dir),
            New_Value_Selected_Acc_Value (New_Obj (Src_Ptr),
                                          Info.T.Range_Dir));
         if Info.T.Range_Length /= O_Fnode_Null then
            New_Assign_Stmt
              (New_Selected_Acc_Value (New_Obj (Dest_Ptr),
                                       Info.T.Range_Length),
               New_Value_Selected_Acc_Value (New_Obj (Src_Ptr),
                                             Info.T.Range_Length));
         end if;
      end Copy_Range;

      procedure Translate_Range_Ptr
        (Res_Ptr : O_Dnode; Arange : Iir; Range_Type : Iir)
      is
      begin
         case Get_Kind (Arange) is
            when Iir_Kind_Range_Array_Attribute =>
               declare
                  Ptr : O_Dnode;
                  Rinfo : Type_Info_Acc;
               begin
                  Rinfo := Get_Info (Get_Base_Type (Range_Type));
                  Open_Temp;
                  Ptr := Create_Temp_Ptr
                    (Rinfo.T.Range_Ptr_Type,
                     Chap14.Translate_Range_Array_Attribute (Arange));
                  Copy_Range (Res_Ptr, Ptr, Rinfo);
                  Close_Temp;
               end;
            when Iir_Kind_Reverse_Range_Array_Attribute =>
               Translate_Reverse_Range_Ptr
                 (Res_Ptr,
                  Chap14.Translate_Range_Array_Attribute (Arange),
                  Range_Type);
            when Iir_Kind_Range_Expression =>
               Translate_Range_Expression_Ptr (Res_Ptr, Arange, Range_Type);
            when others =>
               Error_Kind ("translate_range_ptr", Arange);
         end case;
      end Translate_Range_Ptr;

      procedure Translate_Discrete_Range_Ptr (Res_Ptr : O_Dnode; Arange : Iir)
      is
      begin
         case Get_Kind (Arange) is
            when Iir_Kind_Integer_Subtype_Definition
              | Iir_Kind_Enumeration_Subtype_Definition =>
               if not Is_Anonymous_Type_Definition (Arange) then
                  declare
                     Ptr : O_Dnode;
                     Rinfo : Type_Info_Acc;
                  begin
                     Rinfo := Get_Info (Arange);
                     Open_Temp;
                     Ptr := Create_Temp_Ptr
                       (Rinfo.T.Range_Ptr_Type, Get_Var (Rinfo.T.Range_Var));
                     Copy_Range (Res_Ptr, Ptr, Rinfo);
                     Close_Temp;
                  end;
               else
                  Translate_Range_Ptr (Res_Ptr,
                                       Get_Range_Constraint (Arange),
                                       Get_Base_Type (Arange));
               end if;
            when Iir_Kind_Range_Array_Attribute
              | Iir_Kind_Reverse_Range_Array_Attribute
              | Iir_Kind_Range_Expression =>
               Translate_Range_Ptr (Res_Ptr, Arange, Get_Type (Arange));
            when others =>
               Error_Kind ("translate_discrete_range_ptr", Arange);
         end case;
      end Translate_Discrete_Range_Ptr;

      function Translate_Range (Arange : Iir; Range_Type : Iir)
        return O_Lnode is
      begin
         case Get_Kind (Arange) is
            when Iir_Kinds_Denoting_Name =>
               return Translate_Range (Get_Named_Entity (Arange), Range_Type);
            when Iir_Kind_Subtype_Declaration =>
               --  Must be a scalar subtype.  Range of types is static.
               return Get_Var (Get_Info (Get_Type (Arange)).T.Range_Var);
            when Iir_Kind_Range_Array_Attribute =>
               return Chap14.Translate_Range_Array_Attribute (Arange);
            when Iir_Kind_Reverse_Range_Array_Attribute =>
               declare
                  Res : O_Dnode;
                  Res_Ptr : O_Dnode;
                  Rinfo : Type_Info_Acc;
               begin
                  Rinfo := Get_Info (Range_Type);
                  Res := Create_Temp (Rinfo.T.Range_Type);
                  Open_Temp;
                  Res_Ptr := Create_Temp_Ptr (Rinfo.T.Range_Ptr_Type,
                                              New_Obj (Res));
                  Translate_Reverse_Range_Ptr
                    (Res_Ptr,
                     Chap14.Translate_Range_Array_Attribute (Arange),
                     Range_Type);
                  Close_Temp;
                  return New_Obj (Res);
               end;
            when Iir_Kind_Range_Expression =>
               declare
                  Res : O_Dnode;
                  Ptr : O_Dnode;
                  T_Info : Type_Info_Acc;
               begin
                  T_Info := Get_Info (Range_Type);
                  Res := Create_Temp (T_Info.T.Range_Type);
                  Open_Temp;
                  Ptr := Create_Temp_Ptr (T_Info.T.Range_Ptr_Type,
                                          New_Obj (Res));
                  Translate_Range_Expression_Ptr (Ptr, Arange, Range_Type);
                  Close_Temp;
                  return New_Obj (Res);
               end;
            when others =>
               Error_Kind ("translate_range", Arange);
         end case;
         return O_Lnode_Null;
      end Translate_Range;

      function Translate_Static_Range (Arange : Iir; Range_Type : Iir)
        return O_Cnode
      is
         Constr : O_Record_Aggr_List;
         Res : O_Cnode;
         T_Info : Type_Info_Acc;
      begin
         T_Info := Get_Info (Range_Type);
         Start_Record_Aggr (Constr, T_Info.T.Range_Type);
         New_Record_Aggr_El
           (Constr, Chap7.Translate_Static_Range_Left (Arange, Range_Type));
         New_Record_Aggr_El
           (Constr, Chap7.Translate_Static_Range_Right (Arange, Range_Type));
         New_Record_Aggr_El
           (Constr, Chap7.Translate_Static_Range_Dir (Arange));
         if T_Info.T.Range_Length /= O_Fnode_Null then
            New_Record_Aggr_El
              (Constr, Chap7.Translate_Static_Range_Length (Arange));
         end if;
         Finish_Record_Aggr (Constr, Res);
         return Res;
      end Translate_Static_Range;

      procedure Translate_Predefined_Array_Compare (Subprg : Iir)
      is
         procedure Gen_Compare (L, R : O_Dnode)
         is
            If_Blk1, If_Blk2 : O_If_Block;
         begin
            Start_If_Stmt
              (If_Blk1,
               New_Compare_Op (ON_Neq, New_Obj_Value (L), New_Obj_Value (R),
                               Ghdl_Bool_Type));
            Start_If_Stmt
              (If_Blk2,
               New_Compare_Op (ON_Gt, New_Obj_Value (L), New_Obj_Value (R),
                               Ghdl_Bool_Type));
            New_Return_Stmt (New_Lit (Ghdl_Compare_Gt));
            New_Else_Stmt (If_Blk2);
            New_Return_Stmt (New_Lit (Ghdl_Compare_Lt));
            Finish_If_Stmt (If_Blk2);
            Finish_If_Stmt (If_Blk1);
         end Gen_Compare;

         F_Info : Subprg_Info_Acc;
         Arr_Type : Iir_Array_Type_Definition;
         Arr_Ptr_Type : O_Tnode;
         Info : Type_Info_Acc;
         Id : Name_Id;
         L, R : O_Dnode;
         Interface_List : O_Inter_List;
         If_Blk : O_If_Block;
         Var_L_Len, Var_R_Len : O_Dnode;
         Var_L_El, Var_R_El : O_Dnode;
         Var_I, Var_Len : O_Dnode;
         Label : O_Snode;
         El_Otype : O_Tnode;
      begin
         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Subprg));
         Info := Get_Info (Arr_Type);
         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);

         F_Info := Add_Info (Subprg, Kind_Subprg);
         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);

         --  Create function.
         Start_Function_Decl (Interface_List, Create_Identifier (Id, "_CMP"),
                              Global_Storage, Ghdl_Compare_Type);
         New_Interface_Decl (Interface_List, L, Wki_Left, Arr_Ptr_Type);
         New_Interface_Decl (Interface_List, R, Wki_Right, Arr_Ptr_Type);
         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         El_Otype := Get_Ortho_Type
           (Get_Element_Subtype (Arr_Type), Mode_Value);
         Start_Subprogram_Body (F_Info.Ortho_Func);
         --  Compute length of L and R.
         New_Var_Decl (Var_L_Len, Get_Identifier ("l_len"),
                       O_Storage_Local, Ghdl_Index_Type);
         New_Var_Decl (Var_R_Len, Get_Identifier ("r_len"),
                       O_Storage_Local, Ghdl_Index_Type);
         New_Var_Decl (Var_Len, Wki_Length, O_Storage_Local, Ghdl_Index_Type);
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         New_Assign_Stmt
           (New_Obj (Var_L_Len),
            Chap6.Get_Array_Ptr_Bound_Length
            (New_Obj (L), Arr_Type, 1, Mode_Value));
         New_Assign_Stmt
           (New_Obj (Var_R_Len),
            Chap6.Get_Array_Ptr_Bound_Length
            (New_Obj (R), Arr_Type, 1, Mode_Value));
         --  Find the minimum length.
         Start_If_Stmt (If_Blk,
                        New_Compare_Op (ON_Ge,
                                        New_Obj_Value (Var_L_Len),
                                        New_Obj_Value (Var_R_Len),
                                        Ghdl_Bool_Type));
         New_Assign_Stmt (New_Obj (Var_Len), New_Obj_Value (Var_R_Len));
         New_Else_Stmt (If_Blk);
         New_Assign_Stmt (New_Obj (Var_Len), New_Obj_Value (Var_L_Len));
         Finish_If_Stmt (If_Blk);

         --  for each element, compare elements; if not equal return the
         --       comparaison result.
         Init_Var (Var_I);
         Start_Loop_Stmt (Label);
         Start_If_Stmt (If_Blk, New_Compare_Op (ON_Ge,
                                                New_Obj_Value (Var_I),
                                                New_Obj_Value (Var_Len),
                                                Ghdl_Bool_Type));
         --  Compare the length and return the result.
         Gen_Compare (Var_L_Len, Var_R_Len);
         New_Return_Stmt (New_Lit (Ghdl_Compare_Eq));
         Finish_If_Stmt (If_Blk);
         Start_Declare_Stmt;
         New_Var_Decl (Var_L_El, Get_Identifier ("l_el"), O_Storage_Local,
                       El_Otype);
         New_Var_Decl (Var_R_El, Get_Identifier ("r_el"), O_Storage_Local,
                       El_Otype);
         New_Assign_Stmt
           (New_Obj (Var_L_El),
            New_Value
            (New_Indexed_Element
             (New_Acc_Value (Chap3.Get_Array_Ptr_Base_Ptr
                             (New_Obj (L), Arr_Type, Mode_Value)),
              New_Obj_Value (Var_I))));
         New_Assign_Stmt
           (New_Obj (Var_R_El),
            New_Value
            (New_Indexed_Element
             (New_Acc_Value (Chap3.Get_Array_Ptr_Base_Ptr
                             (New_Obj (R), Arr_Type, Mode_Value)),
              New_Obj_Value (Var_I))));
         Gen_Compare (Var_L_El, Var_R_El);
         Finish_Declare_Stmt;
         Inc_Var (Var_I);
         Finish_Loop_Stmt (Label);
         Finish_Subprogram_Body;
      end Translate_Predefined_Array_Compare;

      --  Find the declaration of the predefined function IMP in type
      --  definition BASE_TYPE.
      function Find_Predefined_Function
        (Base_Type : Iir; Imp : Iir_Predefined_Functions)
        return Iir
      is
         El : Iir;
      begin
         El := Get_Chain (Get_Type_Declarator (Base_Type));
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Implicit_Function_Declaration
                 | Iir_Kind_Implicit_Procedure_Declaration =>
                  if Get_Implicit_Definition (El) = Imp then
                     return El;
                  else
                     El := Get_Chain (El);
                  end if;
               when others =>
                  raise Internal_Error;
            end case;
         end loop;
         raise Internal_Error;
      end Find_Predefined_Function;

      function Translate_Equality (L, R : Mnode; Etype : Iir)
        return O_Enode
      is
         Tinfo : Type_Info_Acc;
      begin
         Tinfo := Get_Type_Info (L);
         case Tinfo.Type_Mode is
            when Type_Mode_Scalar
              | Type_Mode_Acc =>
               return New_Compare_Op (ON_Eq, M2E (L), M2E (R),
                                      Ghdl_Bool_Type);
            when Type_Mode_Fat_Acc =>
               --  a fat pointer.
               declare
                  B : Type_Info_Acc;
                  Ln, Rn : Mnode;
                  V1, V2 : O_Enode;
               begin
                  B := Get_Info (Get_Designated_Type (Etype));
                  Ln := Stabilize (L);
                  Rn := Stabilize (R);
                  V1 := New_Compare_Op
                    (ON_Eq,
                     New_Value (New_Selected_Element
                                (M2Lv (Ln), B.T.Base_Field (Mode_Value))),
                     New_Value (New_Selected_Element
                                (M2Lv (Rn), B.T.Base_Field (Mode_Value))),
                     Std_Boolean_Type_Node);
                  V2 := New_Compare_Op
                    (ON_Eq,
                     New_Value (New_Selected_Element
                                (M2Lv (Ln), B.T.Bounds_Field (Mode_Value))),
                     New_Value (New_Selected_Element
                                (M2Lv (Rn), B.T.Bounds_Field (Mode_Value))),
                     Std_Boolean_Type_Node);
                  return New_Dyadic_Op (ON_And, V1, V2);
               end;

            when Type_Mode_Array =>
               declare
                  Lc, Rc : O_Enode;
                  Base_Type : Iir_Array_Type_Definition;
                  Func : Iir;
               begin
                  Base_Type := Get_Base_Type (Etype);
                  Lc := Translate_Implicit_Conv
                    (M2E (L), Etype, Base_Type, Mode_Value, Null_Iir);
                  Rc := Translate_Implicit_Conv
                    (M2E (R), Etype, Base_Type, Mode_Value, Null_Iir);
                  Func := Find_Predefined_Function
                    (Base_Type, Iir_Predefined_Array_Equality);
                  return Translate_Predefined_Lib_Operator (Lc, Rc, Func);
               end;

            when Type_Mode_Record =>
               declare
                  Func : Iir;
               begin
                  Func := Find_Predefined_Function
                    (Get_Base_Type (Etype), Iir_Predefined_Record_Equality);
                  return Translate_Predefined_Lib_Operator
                    (M2E (L), M2E (R), Func);
               end;

            when Type_Mode_Unknown
              | Type_Mode_File
              | Type_Mode_Fat_Array
              | Type_Mode_Protected =>
               raise Internal_Error;
         end case;
      end Translate_Equality;

      procedure Translate_Predefined_Array_Equality (Subprg : Iir)
      is
         F_Info : Subprg_Info_Acc;
         Arr_Type : Iir_Array_Type_Definition;
         Arr_Ptr_Type : O_Tnode;
         Info : Type_Info_Acc;
         Id : Name_Id;
         Var_L, Var_R : O_Dnode;
         L, R : Mnode;
         Interface_List : O_Inter_List;
         Indexes : Iir_List;
         Nbr_Indexes : Natural;
         If_Blk : O_If_Block;
         Var_I : O_Dnode;
         Var_Len : O_Dnode;
         Label : O_Snode;
         Le, Re : Mnode;
         El_Type : Iir;
      begin
         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Subprg));
         El_Type := Get_Element_Subtype (Arr_Type);
         Info := Get_Info (Arr_Type);
         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);

         F_Info := Add_Info (Subprg, Kind_Subprg);

         --  Create function.
         Start_Function_Decl (Interface_List, Create_Identifier (Id, "_EQ"),
                              Global_Storage, Std_Boolean_Type_Node);
         Chap2.Create_Subprg_Instance (Interface_List, Subprg);
         New_Interface_Decl (Interface_List, Var_L, Wki_Left, Arr_Ptr_Type);
         New_Interface_Decl (Interface_List, Var_R, Wki_Right, Arr_Ptr_Type);
         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         L := Dp2M (Var_L, Info, Mode_Value);
         R := Dp2M (Var_R, Info, Mode_Value);

         Indexes := Get_Index_Subtype_List (Arr_Type);
         Nbr_Indexes := Get_Nbr_Elements (Indexes);

         Start_Subprogram_Body (F_Info.Ortho_Func);
         Chap2.Start_Subprg_Instance_Use (Subprg);
         --  for each dimension:  if length mismatch: return false
         for I in 1 .. Nbr_Indexes loop
            Start_If_Stmt
              (If_Blk,
               New_Compare_Op
               (ON_Neq,
                M2E (Chap3.Range_To_Length
                     (Chap3.Get_Array_Range (L, Arr_Type, I))),
                M2E (Chap3.Range_To_Length
                     (Chap3.Get_Array_Range (R, Arr_Type, I))),
                Std_Boolean_Type_Node));
            New_Return_Stmt (New_Lit (Std_Boolean_False_Node));
            Finish_If_Stmt (If_Blk);
         end loop;

         --  for each element: if element is not equal, return false
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         New_Var_Decl (Var_Len, Wki_Length, O_Storage_Local, Ghdl_Index_Type);
         New_Assign_Stmt (New_Obj (Var_Len),
                          Chap3.Get_Array_Length (L, Arr_Type));
         Init_Var (Var_I);
         Start_Loop_Stmt (Label);
         --  If the end of the array is reached, return TRUE.
         Start_If_Stmt (If_Blk,
                        New_Compare_Op (ON_Ge,
                                        New_Obj_Value (Var_I),
                                        New_Obj_Value (Var_Len),
                                        Ghdl_Bool_Type));
         New_Return_Stmt (New_Lit (Std_Boolean_True_Node));
         Finish_If_Stmt (If_Blk);
         Open_Temp;
         Le := Chap3.Index_Base (Chap3.Get_Array_Base (L), Arr_Type,
                                 New_Obj_Value (Var_I));
         Re := Chap3.Index_Base (Chap3.Get_Array_Base (R), Arr_Type,
                                 New_Obj_Value (Var_I));
         Start_If_Stmt
           (If_Blk,
            New_Monadic_Op (ON_Not, Translate_Equality (Le, Re, El_Type)));
         New_Return_Stmt (New_Lit (Std_Boolean_False_Node));
         Finish_If_Stmt (If_Blk);
         Close_Temp;
         Inc_Var (Var_I);
         Finish_Loop_Stmt (Label);
         Chap2.Finish_Subprg_Instance_Use (Subprg);
         Finish_Subprogram_Body;
      end Translate_Predefined_Array_Equality;

      procedure Translate_Predefined_Record_Equality (Subprg : Iir)
      is
         F_Info : Subprg_Info_Acc;
         Rec_Type : Iir_Record_Type_Definition;
         Rec_Ptr_Type : O_Tnode;
         Info : Type_Info_Acc;
         Id : Name_Id;
         Var_L, Var_R : O_Dnode;
         L, R : Mnode;
         Interface_List : O_Inter_List;
         If_Blk : O_If_Block;
         Le, Re : Mnode;

         El_List : Iir_List;
         El : Iir_Element_Declaration;
      begin
         Rec_Type := Get_Type (Get_Interface_Declaration_Chain (Subprg));
         Info := Get_Info (Rec_Type);
         Id := Get_Identifier (Get_Type_Declarator (Rec_Type));
         Rec_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);

         F_Info := Add_Info (Subprg, Kind_Subprg);
         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);

         --  Create function.
         Start_Function_Decl (Interface_List, Create_Identifier (Id, "_EQ"),
                              Global_Storage, Std_Boolean_Type_Node);
         Chap2.Create_Subprg_Instance (Interface_List, Subprg);
         New_Interface_Decl (Interface_List, Var_L, Wki_Left, Rec_Ptr_Type);
         New_Interface_Decl (Interface_List, Var_R, Wki_Right, Rec_Ptr_Type);
         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Start_Subprogram_Body (F_Info.Ortho_Func);
         Chap2.Start_Subprg_Instance_Use (Subprg);

         L := Dp2M (Var_L, Info, Mode_Value);
         R := Dp2M (Var_R, Info, Mode_Value);

         --   Compare each element.
         El_List := Get_Elements_Declaration_List (Rec_Type);
         for I in Natural loop
            El := Get_Nth_Element (El_List, I);
            exit when El = Null_Iir;
            Le := Chap6.Translate_Selected_Element (L, El);
            Re := Chap6.Translate_Selected_Element (R, El);

            Open_Temp;
            Start_If_Stmt
              (If_Blk,
               New_Monadic_Op (ON_Not,
                               Translate_Equality (Le, Re, Get_Type (El))));
            New_Return_Stmt (New_Lit (Std_Boolean_False_Node));
            Finish_If_Stmt (If_Blk);
            Close_Temp;
         end loop;
         New_Return_Stmt (New_Lit (Std_Boolean_True_Node));
         Chap2.Finish_Subprg_Instance_Use (Subprg);
         Finish_Subprogram_Body;
      end Translate_Predefined_Record_Equality;

      procedure Translate_Predefined_Array_Array_Concat (Subprg : Iir)
      is
         F_Info : Subprg_Info_Acc;
         Arr_Type : Iir_Array_Type_Definition;
         Arr_Ptr_Type : O_Tnode;

         --  Info for the array type.
         Info : Type_Info_Acc;

         --  Info for the index type.
         Iinfo : Type_Info_Acc;
         Index_Type : Iir;

         Index_Otype : O_Tnode;
         Id : Name_Id;
         Interface_List : O_Inter_List;
         Var_Res, Var_L, Var_R : O_Dnode;
         Res, L, R : Mnode;
         Var_Length, Var_L_Len, Var_R_Len : O_Dnode;
         Var_Bounds, Var_Right : O_Dnode;
         V_Bounds : Mnode;
         If_Blk : O_If_Block;
      begin
         Arr_Type := Get_Return_Type (Subprg);
         Info := Get_Info (Arr_Type);
         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);

         F_Info := Add_Info (Subprg, Kind_Subprg);
         F_Info.Use_Stack2 := True;

         --  Create function.
         Start_Procedure_Decl
           (Interface_List, Create_Identifier (Id, "_CONCAT"), Global_Storage);
         --  Note: contrary to user function which returns composite value
         --  via a result record, a concatenation returns its value without
         --  the use of the record.
         Chap2.Create_Subprg_Instance (Interface_List, Subprg);
         New_Interface_Decl (Interface_List, Var_Res, Wki_Res, Arr_Ptr_Type);
         New_Interface_Decl (Interface_List, Var_L, Wki_Left, Arr_Ptr_Type);
         New_Interface_Decl (Interface_List, Var_R, Wki_Right, Arr_Ptr_Type);
         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Index_Type := Get_Index_Type (Arr_Type, 0);
         Iinfo := Get_Info (Index_Type);
         Index_Otype := Iinfo.Ortho_Type (Mode_Value);

         Start_Subprogram_Body (F_Info.Ortho_Func);
         Chap2.Start_Subprg_Instance_Use (Subprg);
         New_Var_Decl (Var_Length, Wki_Length, O_Storage_Local,
                       Ghdl_Index_Type);
         New_Var_Decl (Var_L_Len, Get_Identifier ("l_len"), O_Storage_Local,
                       Ghdl_Index_Type);
         New_Var_Decl (Var_R_Len, Get_Identifier ("r_len"), O_Storage_Local,
                       Ghdl_Index_Type);
         New_Var_Decl (Var_Bounds, Get_Identifier ("bounds"), O_Storage_Local,
                       Info.T.Bounds_Ptr_Type);

         L := Dp2M (Var_L, Info, Mode_Value);
         R := Dp2M (Var_R, Info, Mode_Value);
         Res := Dp2M (Var_Res, Info, Mode_Value);
         V_Bounds := Dp2M (Var_Bounds, Info, Mode_Value,
                           Info.T.Bounds_Type, Info.T.Bounds_Ptr_Type);

         --  Compute length.
         New_Assign_Stmt
           (New_Obj (Var_L_Len), Chap3.Get_Array_Length (L, Arr_Type));
         New_Assign_Stmt
           (New_Obj (Var_R_Len), Chap3.Get_Array_Length (R, Arr_Type));
         New_Assign_Stmt
           (New_Obj (Var_Length), New_Dyadic_Op (ON_Add_Ov,
                                                 New_Obj_Value (Var_L_Len),
                                                 New_Obj_Value (Var_R_Len)));

         --  Check case where the result is the right operand.
         declare
            Len : O_Enode;
         begin
            if Flags.Vhdl_Std = Vhdl_87 then
               --  LRM87 7.2.4
               --  [...], unless the left operand is a null array, in which
               --  case the result of the concatenation is the right operand.
               Len := New_Obj_Value (Var_L_Len);

            else
               --  LRM93 7.2.4
               --  If both operands are null arrays, then the result of the
               --  concatenation is the right operand.
               --  GHDL: since the length type is unsigned, then both operands
               --   are null arrays iff the result is a null array.
               Len := New_Obj_Value (Var_Length);
            end if;

            Start_If_Stmt
              (If_Blk,
               New_Compare_Op (ON_Eq,
                               Len,
                               New_Lit (Ghdl_Index_0),
                               Ghdl_Bool_Type));
            Copy_Fat_Pointer (Res, R);
            New_Return_Stmt;
            Finish_If_Stmt (If_Blk);
         end;

         --  Allocate bounds.
         New_Assign_Stmt
           (New_Obj (Var_Bounds),
            Gen_Alloc (Alloc_Return,
                       New_Lit (New_Sizeof (Info.T.Bounds_Type,
                                            Ghdl_Index_Type)),
                       Info.T.Bounds_Ptr_Type));
         New_Assign_Stmt
           (M2Lp (Chap3.Get_Array_Bounds (Res)), New_Obj_Value (Var_Bounds));

         --  Set bound.
         if Flags.Vhdl_Std = Vhdl_87 then
            --  Set length.
            New_Assign_Stmt
              (M2Lv (Chap3.Range_To_Length
                     (Chap3.Bounds_To_Range (V_Bounds, Arr_Type, 1))),
               New_Obj_Value (Var_Length));

            --  Set direction, left bound and right bound.
            --  LRM87 7.2.4
            --  The left bound of this result is the left bound of the left
            --  operand, unless the left operand is a null array, in which
            --  case the result of the concatenation is the right operand.
            --  The direction of the result is the direction of the left
            --  operand, unless the left operand is a null array, in which
            --  case the direction of the result is that of the right operand.
            declare
               Var_Dir, Var_Left : O_Dnode;
               Var_Length1 : O_Dnode;
            begin
               Start_Declare_Stmt;
               New_Var_Decl (Var_Right, Get_Identifier ("right_bound"),
                             O_Storage_Local, Index_Otype);
               New_Var_Decl (Var_Dir, Wki_Dir, O_Storage_Local,
                             Ghdl_Dir_Type_Node);
               New_Var_Decl (Var_Left, Get_Identifier ("left_bound"),
                             O_Storage_Local, Iinfo.Ortho_Type (Mode_Value));
               New_Var_Decl (Var_Length1, Get_Identifier ("length_1"),
                             O_Storage_Local, Ghdl_Index_Type);
               New_Assign_Stmt
                 (New_Obj (Var_Dir),
                  M2E (Chap3.Range_To_Dir
                       (Chap3.Get_Array_Range (L, Arr_Type, 1))));
               New_Assign_Stmt
                 (M2Lv (Chap3.Range_To_Dir
                        (Chap3.Bounds_To_Range (V_Bounds, Arr_Type, 1))),
                  New_Obj_Value (Var_Dir));
               New_Assign_Stmt
                 (New_Obj (Var_Left),
                  M2E (Chap3.Range_To_Left
                       (Chap3.Get_Array_Range (L, Arr_Type, 1))));
               --  Note this substraction cannot overflow, since LENGTH >= 1.
               New_Assign_Stmt
                 (New_Obj (Var_Length1),
                  New_Dyadic_Op (ON_Sub_Ov,
                                 New_Obj_Value (Var_Length),
                                 New_Lit (Ghdl_Index_1)));
               New_Assign_Stmt
                 (M2Lv (Chap3.Range_To_Left
                        (Chap3.Bounds_To_Range (V_Bounds, Arr_Type, 1))),
                  New_Obj_Value (Var_Left));
               Start_If_Stmt
                 (If_Blk,
                  New_Compare_Op (ON_Eq, New_Obj_Value (Var_Dir),
                                  New_Lit (Ghdl_Dir_To_Node), Ghdl_Bool_Type));
               New_Assign_Stmt
                 (New_Obj (Var_Right),
                  New_Dyadic_Op (ON_Add_Ov,
                                 New_Obj_Value (Var_Left),
                                 New_Convert_Ov (New_Obj_Value (Var_Length1),
                                                 Index_Otype)));
               New_Else_Stmt (If_Blk);
               New_Assign_Stmt
                 (New_Obj (Var_Right),
                  New_Dyadic_Op (ON_Sub_Ov,
                                 New_Obj_Value (Var_Left),
                                 New_Convert_Ov (New_Obj_Value (Var_Length1),
                                                 Index_Otype)));
               Finish_If_Stmt (If_Blk);
               --   Check the right bounds is inside the bounds of the
               --   index type.
               Chap3.Check_Range (Var_Right, Null_Iir, Index_Type, Subprg);
               New_Assign_Stmt
                 (M2Lv (Chap3.Range_To_Right
                        (Chap3.Bounds_To_Range (V_Bounds, Arr_Type, 1))),
                  New_Obj_Value (Var_Right));
               Finish_Declare_Stmt;
            end;
         else
            --  LRM93 7.2.4
            --  [...], the direction and bounds of the result are determined
            --  as follows: Let S be the index subtype of the base type of the
            --  result.  The direction of the result of the concatenation is
            --  the direction of S, and the left bound of the result is
            --  S'LEFT.
            declare
               Var_Range_Ptr : O_Dnode;
            begin
               Start_Declare_Stmt;
               New_Var_Decl (Var_Range_Ptr, Get_Identifier ("range_ptr"),
                             O_Storage_Local, Iinfo.T.Range_Ptr_Type);
               New_Assign_Stmt
                 (New_Obj (Var_Range_Ptr),
                  M2Addr (Chap3.Bounds_To_Range (V_Bounds, Arr_Type, 1)));
               Chap3.Create_Range_From_Length
                 (Index_Type, Var_Length, Var_Range_Ptr, Subprg);
               Finish_Declare_Stmt;
            end;
         end if;

         --  Allocate array base.
         Chap3.Allocate_Fat_Array_Base (Alloc_Return, Res, Arr_Type);

         --  Copy left.
         declare
            V_Arr : O_Dnode;
            Var_Arr : Mnode;
         begin
            Open_Temp;
            V_Arr := Create_Temp (Info.Ortho_Type (Mode_Value));
            Var_Arr := Dv2M (V_Arr, Info, Mode_Value);
            New_Assign_Stmt
              (M2Lp (Chap3.Get_Array_Bounds (Var_Arr)),
               M2Addr (Chap3.Get_Array_Bounds (L)));
            New_Assign_Stmt
              (M2Lp (Chap3.Get_Array_Base (Var_Arr)),
               M2Addr (Chap3.Get_Array_Base (Res)));
            Chap3.Translate_Object_Copy
              (Var_Arr, New_Obj_Value (Var_L), Arr_Type);
            Close_Temp;
         end;

         --  Copy right.
         declare
            V_Arr : O_Dnode;
            Var_Arr : Mnode;
         begin
            Open_Temp;
            V_Arr := Create_Temp (Info.Ortho_Type (Mode_Value));
            Var_Arr := Dv2M (V_Arr, Info, Mode_Value);
            New_Assign_Stmt
              (M2Lp (Chap3.Get_Array_Bounds (Var_Arr)),
               M2Addr (Chap3.Get_Array_Bounds (R)));
            New_Assign_Stmt
              (M2Lp (Chap3.Get_Array_Base (Var_Arr)),
               M2Addr (Chap3.Slice_Base (Chap3.Get_Array_Base (Res),
                                         Arr_Type,
                                         New_Obj_Value (Var_L_Len))));
            Chap3.Translate_Object_Copy
              (Var_Arr, New_Obj_Value (Var_R), Arr_Type);
            Close_Temp;
         end;
         Chap2.Finish_Subprg_Instance_Use (Subprg);
         Finish_Subprogram_Body;
      end Translate_Predefined_Array_Array_Concat;

      procedure Translate_Predefined_Array_Logical (Subprg : Iir)
      is
         F_Info : Subprg_Info_Acc;
         Arr_Type : Iir_Array_Type_Definition;
         Arr_Ptr_Type : O_Tnode;
         --  Info for the array type.
         Info : Type_Info_Acc;
         Id : Name_Id;
         Interface_List : O_Inter_List;
         Var_Res : O_Dnode;
         Res : Mnode;
         L, R : O_Dnode;
         Var_Length, Var_I : O_Dnode;
         Var_Base, Var_L_Base, Var_R_Base : O_Dnode;
         If_Blk : O_If_Block;
         Label : O_Snode;
         Name : O_Ident;
         Is_Monadic : Boolean;
         El, L_El : O_Enode;
         Op : ON_Op_Kind;
         Do_Invert : Boolean;
      begin
         Arr_Type := Get_Type (Get_Interface_Declaration_Chain (Subprg));
         Info := Get_Info (Arr_Type);
         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);

         F_Info := Add_Info (Subprg, Kind_Subprg);
         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);
         F_Info.Use_Stack2 := True;

         Is_Monadic := False;
         case Get_Implicit_Definition (Subprg) is
            when Iir_Predefined_TF_Array_And =>
               Name := Create_Identifier (Id, "_AND");
               Op := ON_And;
               Do_Invert := False;
            when Iir_Predefined_TF_Array_Or =>
               Name := Create_Identifier (Id, "_OR");
               Op := ON_Or;
               Do_Invert := False;
            when Iir_Predefined_TF_Array_Nand =>
               Name := Create_Identifier (Id, "_NAND");
               Op := ON_And;
               Do_Invert := True;
            when Iir_Predefined_TF_Array_Nor =>
               Name := Create_Identifier (Id, "_NOR");
               Op := ON_Or;
               Do_Invert := True;
            when Iir_Predefined_TF_Array_Xor =>
               Name := Create_Identifier (Id, "_XOR");
               Op := ON_Xor;
               Do_Invert := False;
            when Iir_Predefined_TF_Array_Xnor =>
               Name := Create_Identifier (Id, "_XNOR");
               Op := ON_Xor;
               Do_Invert := True;
            when Iir_Predefined_TF_Array_Not =>
               Name := Create_Identifier (Id, "_NOT");
               Is_Monadic := True;
               Op := ON_Not;
               Do_Invert := False;
            when others =>
               raise Internal_Error;
         end case;

         --  Create function.
         Start_Procedure_Decl (Interface_List, Name, Global_Storage);
         --  Note: contrary to user function which returns composite value
         --  via a result record, a concatenation returns its value without
         --  the use of the record.
         New_Interface_Decl (Interface_List, Var_Res, Wki_Res, Arr_Ptr_Type);
         New_Interface_Decl (Interface_List, L, Wki_Left, Arr_Ptr_Type);
         if not Is_Monadic then
            New_Interface_Decl (Interface_List, R, Wki_Right, Arr_Ptr_Type);
         end if;
         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Start_Subprogram_Body (F_Info.Ortho_Func);
         New_Var_Decl (Var_Length, Wki_Length, O_Storage_Local,
                       Ghdl_Index_Type);
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         New_Var_Decl (Var_Base, Get_Identifier ("base"), O_Storage_Local,
                       Info.T.Base_Ptr_Type (Mode_Value));
         New_Var_Decl (Var_L_Base, Get_Identifier ("l_base"), O_Storage_Local,
                       Info.T.Base_Ptr_Type (Mode_Value));
         if not Is_Monadic then
            New_Var_Decl
              (Var_R_Base, Get_Identifier ("r_base"), O_Storage_Local,
               Info.T.Base_Ptr_Type (Mode_Value));
         end if;
         Open_Temp;
         --  Get length of LEFT.
         New_Assign_Stmt (New_Obj (Var_Length),
                          Chap6.Get_Array_Ptr_Bound_Length
                          (New_Obj (L), Arr_Type, 1, Mode_Value));
         --  If dyadic, check RIGHT has the same length.
         if not Is_Monadic then
            Chap6.Check_Bound_Error
              (New_Compare_Op (ON_Neq,
                               New_Obj_Value (Var_Length),
                               Chap6.Get_Array_Ptr_Bound_Length
                               (New_Obj (R), Arr_Type, 1, Mode_Value),
                               Ghdl_Bool_Type),
               Subprg, 0);
         end if;

         --  Create the result from LEFT bound.
         Res := Dp2M (Var_Res, Info, Mode_Value);
         Chap3.Translate_Object_Allocation
           (Res, Alloc_Return, Arr_Type,
            Chap3.Get_Array_Ptr_Bounds_Ptr
            (New_Obj (L), Arr_Type, Mode_Value));
         New_Assign_Stmt
           (New_Obj (Var_Base), M2Addr (Chap3.Get_Array_Base (Res)));
         New_Assign_Stmt
           (New_Obj (Var_L_Base),
            New_Value (Chap3.Get_Array_Ptr_Base_Ptr
                       (New_Obj (L), Arr_Type, Mode_Value)));
         if not Is_Monadic then
            New_Assign_Stmt
              (New_Obj (Var_R_Base),
               New_Value (Chap3.Get_Array_Ptr_Base_Ptr
                          (New_Obj (R), Arr_Type, Mode_Value)));
         end if;

         --  Do the logical operation on each element.
         Init_Var (Var_I);
         Start_Loop_Stmt (Label);
         Start_If_Stmt (If_Blk,
                        New_Compare_Op (ON_Ge,
                                        New_Obj_Value (Var_I),
                                        New_Obj_Value (Var_Length),
                                        Ghdl_Bool_Type));
         New_Return_Stmt;
         Finish_If_Stmt (If_Blk);
         L_El := New_Value (New_Indexed_Element
                            (New_Acc_Value (New_Obj (Var_L_Base)),
                             New_Obj_Value (Var_I)));
         if Is_Monadic then
            El := New_Monadic_Op (Op, L_El);
         else
            El := New_Dyadic_Op
              (Op, L_El,
               New_Value (New_Indexed_Element
                          (New_Acc_Value (New_Obj (Var_R_Base)),
                           New_Obj_Value (Var_I))));
         end if;
         if Do_Invert then
            El := New_Monadic_Op (ON_Not, El);
         end if;

         New_Assign_Stmt (New_Indexed_Element
                          (New_Acc_Value (New_Obj (Var_Base)),
                           New_Obj_Value (Var_I)),
                          El);
         Inc_Var (Var_I);
         Finish_Loop_Stmt (Label);
         Close_Temp;
         Finish_Subprogram_Body;
      end Translate_Predefined_Array_Logical;

      procedure Translate_Predefined_Array_Shift (Subprg : Iir)
      is
         F_Info : Subprg_Info_Acc;
         Inter : Iir;
         Arr_Type : Iir_Array_Type_Definition;
         Arr_Ptr_Type : O_Tnode;
         Int_Type : O_Tnode;
         --  Info for the array type.
         Info : Type_Info_Acc;
         Id : Name_Id;
         Interface_List : O_Inter_List;
         Var_Res : O_Dnode;
         Var_L, Var_R : O_Dnode;
         Name : O_Ident;

         type Shift_Kind is (Sh_Logical, Sh_Arith, Rotation);
         Shift : Shift_Kind;

         --  Body;
         Var_Length, Var_I, Var_I1 : O_Dnode;
         Var_Res_Base, Var_L_Base : O_Dnode;
         Var_Rl : O_Dnode;
         Var_E : O_Dnode;
         L : Mnode;
         If_Blk, If_Blk1 : O_If_Block;
         Label : O_Snode;
         Res : Mnode;

         procedure Do_Shift (To_Right : Boolean)
         is
            Tmp : O_Enode;
         begin
            --  * If R < LENGTH then
            Start_If_Stmt (If_Blk1,
                           New_Compare_Op (ON_Lt,
                                           New_Obj_Value (Var_Rl),
                                           New_Obj_Value (Var_Length),
                                           Ghdl_Bool_Type));
            --  RIGHT:
            --  *   for I = R to LENGTH - 1 loop
            --  *     RES[I] := L[I - R]
            --  LEFT:
            --  *   for I = 0 to LENGTH - R loop
            --  *     RES[I] := L[R + I]
            if To_Right then
               New_Assign_Stmt (New_Obj (Var_I), New_Obj_Value (Var_Rl));
               Init_Var (Var_I1);
            else
               Init_Var (Var_I);
               New_Assign_Stmt (New_Obj (Var_I1), New_Obj_Value (Var_Rl));
            end if;
            Start_Loop_Stmt (Label);
            if To_Right then
               Tmp := New_Obj_Value (Var_I);
            else
               Tmp := New_Obj_Value (Var_I1);
            end if;
            Gen_Exit_When (Label, New_Compare_Op (ON_Ge,
                                                  Tmp,
                                                  New_Obj_Value (Var_Length),
                                                  Ghdl_Bool_Type));
            New_Assign_Stmt
              (New_Indexed_Acc_Value (New_Obj (Var_Res_Base),
                                      New_Obj_Value (Var_I)),
               New_Value
               (New_Indexed_Acc_Value (New_Obj (Var_L_Base),
                                       New_Obj_Value (Var_I1))));
            Inc_Var (Var_I);
            Inc_Var (Var_I1);
            Finish_Loop_Stmt (Label);
            New_Else_Stmt (If_Blk1);
            --  * else
            --  *   R := LENGTH
            New_Assign_Stmt (New_Obj (Var_Rl), New_Obj_Value (Var_Length));
            Finish_If_Stmt (If_Blk1);

            --  RIGHT:
            --  * For I = 0 to R - 1
            --  *   RES[I] := 0/L[0/LENGTH-1]
            --  LEFT:
            --  * For I = LENGTH - R to LENGTH - 1
            --  *   RES[I] := 0/L[0/LENGTH-1]
            if To_Right then
               Init_Var (Var_I);
            else
               --  I is yet correctly set.
               null;
            end if;
            if Shift = Sh_Arith then
               if To_Right then
                  Tmp := New_Lit (Ghdl_Index_0);
               else
                  Tmp := New_Dyadic_Op
                    (ON_Sub_Ov,
                     New_Obj_Value (Var_Length),
                     New_Lit (Ghdl_Index_1));
               end if;
               New_Assign_Stmt
                 (New_Obj (Var_E),
                  New_Value (New_Indexed_Acc_Value (New_Obj (Var_L_Base),
                                                    Tmp)));
            end if;
            Start_Loop_Stmt (Label);
            if To_Right then
               Tmp := New_Obj_Value (Var_Rl);
            else
               Tmp := New_Obj_Value (Var_Length);
            end if;
            Gen_Exit_When (Label, New_Compare_Op (ON_Ge,
                                                  New_Obj_Value (Var_I),
                                                  Tmp,
                                                  Ghdl_Bool_Type));
            case Shift is
               when Sh_Logical =>
                  declare
                     Enum_List : Iir_List;
                  begin
                     Enum_List := Get_Enumeration_Literal_List
                       (Get_Base_Type (Get_Element_Subtype (Arr_Type)));
                     Tmp := New_Lit
                       (Get_Ortho_Expr (Get_First_Element (Enum_List)));
                  end;
               when Sh_Arith =>
                  Tmp := New_Obj_Value (Var_E);
               when Rotation =>
                  raise Internal_Error;
            end case;

            New_Assign_Stmt
              (New_Indexed_Acc_Value (New_Obj (Var_Res_Base),
                                      New_Obj_Value (Var_I)), Tmp);
            Inc_Var (Var_I);
            Finish_Loop_Stmt (Label);
         end Do_Shift;
      begin
         Inter := Get_Interface_Declaration_Chain (Subprg);

         Info := Get_Info (Get_Type (Get_Chain (Inter)));
         Int_Type := Info.Ortho_Type (Mode_Value);

         Arr_Type := Get_Type (Inter);
         Info := Get_Info (Arr_Type);
         Id := Get_Identifier (Get_Type_Declarator (Arr_Type));
         Arr_Ptr_Type := Info.Ortho_Ptr_Type (Mode_Value);

         F_Info := Add_Info (Subprg, Kind_Subprg);
         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);
         F_Info.Use_Stack2 := True;

         case Get_Implicit_Definition (Subprg) is
            when Iir_Predefined_Array_Sll
              | Iir_Predefined_Array_Srl =>
               --  Shift logical.
               Name := Create_Identifier (Id, "_SHL");
               Shift := Sh_Logical;
            when Iir_Predefined_Array_Sla
              | Iir_Predefined_Array_Sra =>
               --  Shift arithmetic.
               Name := Create_Identifier (Id, "_SHA");
               Shift := Sh_Arith;
            when Iir_Predefined_Array_Rol
              | Iir_Predefined_Array_Ror =>
               --  Rotation
               Name := Create_Identifier (Id, "_ROT");
               Shift := Rotation;
            when others =>
               raise Internal_Error;
         end case;

         --  Create function.
         Start_Procedure_Decl (Interface_List, Name, Global_Storage);
         --  Note: contrary to user function which returns composite value
         --  via a result record, a shift returns its value without
         --  the use of the record.
         New_Interface_Decl (Interface_List, Var_Res, Wki_Res, Arr_Ptr_Type);
         New_Interface_Decl (Interface_List, Var_L, Wki_Left, Arr_Ptr_Type);
         New_Interface_Decl (Interface_List, Var_R, Wki_Right, Int_Type);
         Finish_Subprogram_Decl (Interface_List, F_Info.Ortho_Func);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         --  Body
         Start_Subprogram_Body (F_Info.Ortho_Func);
         New_Var_Decl (Var_Length, Wki_Length, O_Storage_Local,
                       Ghdl_Index_Type);
         if Shift /= Rotation then
            New_Var_Decl (Var_Rl, Get_Identifier ("rl"), O_Storage_Local,
                          Ghdl_Index_Type);
         end if;
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         New_Var_Decl (Var_I1, Get_Identifier ("I1"), O_Storage_Local,
                       Ghdl_Index_Type);
         New_Var_Decl (Var_Res_Base, Get_Identifier ("res_base"),
                       O_Storage_Local, Info.T.Base_Ptr_Type (Mode_Value));
         New_Var_Decl (Var_L_Base, Get_Identifier ("l_base"),
                       O_Storage_Local, Info.T.Base_Ptr_Type (Mode_Value));
         if Shift = Sh_Arith then
            New_Var_Decl (Var_E, Get_Identifier ("E"), O_Storage_Local,
                          Get_Info (Get_Element_Subtype (Arr_Type)).
                          Ortho_Type (Mode_Value));
         end if;
         Res := Dp2M (Var_Res, Info, Mode_Value);
         L := Dp2M (Var_L, Info, Mode_Value);

         --  LRM93 7.2.3
         --  The index subtypes of the return values of all shift operators is
         --  the same as the index subtype of their left arguments.
         New_Assign_Stmt
           (M2Lp (Chap3.Get_Array_Bounds (Res)),
            M2Addr (Chap3.Get_Array_Bounds (L)));

         --  Get length of LEFT.
         New_Assign_Stmt (New_Obj (Var_Length),
                          Chap3.Get_Array_Length (L, Arr_Type));

         --  LRM93 7.2.3 [6 times]
         --  That is, if R is 0 or L is a null array, the return value is L.
         Start_If_Stmt
           (If_Blk,
            New_Dyadic_Op
            (ON_Or,
             New_Compare_Op (ON_Eq,
                             New_Obj_Value (Var_R),
                             New_Lit (New_Signed_Literal (Int_Type, 0)),
                             Ghdl_Bool_Type),
             New_Compare_Op (ON_Eq,
                             New_Obj_Value (Var_Length),
                             New_Lit (Ghdl_Index_0),
                             Ghdl_Bool_Type)));
         New_Assign_Stmt
           (M2Lp (Chap3.Get_Array_Base (Res)),
            M2Addr (Chap3.Get_Array_Base (L)));
         New_Return_Stmt;
         Finish_If_Stmt (If_Blk);

         --  Allocate base.
         New_Assign_Stmt
           (New_Obj (Var_Res_Base),
            Gen_Alloc (Alloc_Return, New_Obj_Value (Var_Length),
                       Info.T.Base_Ptr_Type (Mode_Value)));
         New_Assign_Stmt (M2Lp (Chap3.Get_Array_Base (Res)),
                          New_Obj_Value (Var_Res_Base));

         New_Assign_Stmt (New_Obj (Var_L_Base),
                          M2Addr (Chap3.Get_Array_Base (L)));

         Start_If_Stmt (If_Blk,
                        New_Compare_Op (ON_Gt,
                                        New_Obj_Value (Var_R),
                                        New_Lit (New_Signed_Literal (Int_Type,
                                                                     0)),
                                        Ghdl_Bool_Type));
         --  R > 0.
         --  Ie, to the right
         case Shift is
            when Rotation =>
               --  * I1 := LENGTH - (R mod LENGTH)
               New_Assign_Stmt
                 (New_Obj (Var_I1),
                  New_Dyadic_Op
                  (ON_Sub_Ov,
                   New_Obj_Value (Var_Length),
                   New_Dyadic_Op (ON_Mod_Ov,
                                  New_Convert_Ov (New_Obj_Value (Var_R),
                                                  Ghdl_Index_Type),
                                  New_Obj_Value (Var_Length))));

            when Sh_Logical
              | Sh_Arith =>
               --  Real SRL or SRA.
               New_Assign_Stmt
                 (New_Obj (Var_Rl),
                  New_Convert_Ov (New_Obj_Value (Var_R), Ghdl_Index_Type));

               Do_Shift (True);
         end case;

         New_Else_Stmt (If_Blk);

         --  R < 0, to the left.
         case Shift is
            when Rotation =>
               --  * I1 := (-R) mod LENGTH
               New_Assign_Stmt
                 (New_Obj (Var_I1),
                  New_Dyadic_Op (ON_Mod_Ov,
                                 New_Convert_Ov
                                 (New_Monadic_Op (ON_Neg_Ov,
                                                  New_Obj_Value (Var_R)),
                                  Ghdl_Index_Type),
                                 New_Obj_Value (Var_Length)));
            when Sh_Logical
              | Sh_Arith =>
               --  Real SLL or SLA.
               New_Assign_Stmt
                 (New_Obj (Var_Rl),
                  New_Convert_Ov (New_Monadic_Op (ON_Neg_Ov,
                                                  New_Obj_Value (Var_R)),
                                  Ghdl_Index_Type));

               Do_Shift (False);
         end case;
         Finish_If_Stmt (If_Blk);

         if Shift = Rotation then
            --  *     If I1 = LENGTH then
            --  *        I1 := 0
            Start_If_Stmt (If_Blk, New_Compare_Op (ON_Ge,
                                                   New_Obj_Value (Var_I1),
                                                   New_Obj_Value (Var_Length),
                                                   Ghdl_Bool_Type));
            Init_Var (Var_I1);
            Finish_If_Stmt (If_Blk);

            --  *   for I = 0 to LENGTH - 1 loop
            --  *     RES[I] := L[I1];
            Init_Var (Var_I);
            Start_Loop_Stmt (Label);
            Gen_Exit_When (Label, New_Compare_Op (ON_Ge,
                                                  New_Obj_Value (Var_I),
                                                  New_Obj_Value (Var_Length),
                                                  Ghdl_Bool_Type));
            New_Assign_Stmt
              (New_Indexed_Acc_Value (New_Obj (Var_Res_Base),
                                      New_Obj_Value (Var_I)),
               New_Value
               (New_Indexed_Acc_Value (New_Obj (Var_L_Base),
                                       New_Obj_Value (Var_I1))));
            Inc_Var (Var_I);
            --  *     I1 := I1 + 1
            Inc_Var (Var_I1);
            --  *     If I1 = LENGTH then
            --  *        I1 := 0
            Start_If_Stmt (If_Blk, New_Compare_Op (ON_Ge,
                                                   New_Obj_Value (Var_I1),
                                                   New_Obj_Value (Var_Length),
                                                   Ghdl_Bool_Type));
            Init_Var (Var_I1);
            Finish_If_Stmt (If_Blk);
            Finish_Loop_Stmt (Label);
         end if;
         Finish_Subprogram_Body;
      end Translate_Predefined_Array_Shift;

      procedure Translate_File_Subprogram (Subprg : Iir; File_Type : Iir)
      is
         Etype : Iir;
         Tinfo : Type_Info_Acc;
         Kind : Iir_Predefined_Functions;
         F_Info : Subprg_Info_Acc;
         Name : O_Ident;
         Inter_List : O_Inter_List;
         Id : Name_Id;
         Var_File : O_Dnode;
         Var_Val : O_Dnode;

         procedure Translate_Rw (Val : Mnode; Val_Type : Iir; Proc : O_Dnode);

         procedure Translate_Rw_Array
           (Val : Mnode; Val_Type : Iir; Var_Max : O_Dnode; Proc : O_Dnode)
         is
            Var_It : O_Dnode;
            Label : O_Snode;
         begin
            Var_It := Create_Temp (Ghdl_Index_Type);
            Init_Var (Var_It);
            Start_Loop_Stmt (Label);
            Gen_Exit_When
              (Label,
               New_Compare_Op (ON_Eq,
                               New_Obj_Value (Var_It),
                               New_Obj_Value (Var_Max),
                               Ghdl_Bool_Type));
            Translate_Rw
              (Chap3.Index_Base (Val, Val_Type, New_Obj_Value (Var_It)),
               Get_Element_Subtype (Val_Type), Proc);
            Inc_Var (Var_It);
            Finish_Loop_Stmt (Label);
         end Translate_Rw_Array;

         procedure Translate_Rw (Val : Mnode; Val_Type : Iir; Proc : O_Dnode)
         is
            Val_Info : Type_Info_Acc;
            Assocs : O_Assoc_List;
         begin
            Val_Info := Get_Type_Info (Val);
            case Val_Info.Type_Mode is
               when Type_Mode_Scalar =>
                  Start_Association (Assocs, Proc);
                  --    compute file parameter (get an index)
                  New_Association (Assocs, New_Obj_Value (Var_File));
                  --    compute the value.
                  New_Association
                    (Assocs, New_Convert_Ov (M2Addr (Val), Ghdl_Ptr_Type));
                  --    length.
                  New_Association
                    (Assocs,
                     New_Lit (New_Sizeof (Val_Info.Ortho_Type (Mode_Value),
                                          Ghdl_Index_Type)));
                  --    call a predefined procedure
                  New_Procedure_Call (Assocs);
               when Type_Mode_Record =>
                  declare
                     El_List : Iir_List;
                     El : Iir;
                     Val1 : Mnode;
                  begin
                     Open_Temp;
                     Val1 := Stabilize (Val);
                     El_List := Get_Elements_Declaration_List
                       (Get_Base_Type (Val_Type));
                     for I in Natural loop
                        El := Get_Nth_Element (El_List, I);
                        exit when El = Null_Iir;
                        Translate_Rw
                          (Chap6.Translate_Selected_Element (Val1, El),
                           Get_Type (El), Proc);
                     end loop;
                     Close_Temp;
                  end;
               when Type_Mode_Array =>
                  declare
                     Var_Max : O_Dnode;
                  begin
                     Open_Temp;
                     Var_Max := Create_Temp (Ghdl_Index_Type);
                     New_Assign_Stmt
                       (New_Obj (Var_Max),
                        Chap3.Get_Array_Type_Length (Val_Type));
                     Translate_Rw_Array (Val, Val_Type, Var_Max, Proc);
                     Close_Temp;
                  end;
               when Type_Mode_Unknown
                 | Type_Mode_File
                 | Type_Mode_Acc
                 | Type_Mode_Fat_Acc
                 | Type_Mode_Fat_Array
                 | Type_Mode_Protected =>
                  raise Internal_Error;
            end case;
         end Translate_Rw;

         procedure Translate_Rw_Length (Var_Length : O_Dnode; Proc : O_Dnode)
         is
            Assocs : O_Assoc_List;
         begin
            Start_Association (Assocs, Proc);
            New_Association (Assocs, New_Obj_Value (Var_File));
            New_Association
              (Assocs, New_Unchecked_Address (New_Obj (Var_Length),
                                              Ghdl_Ptr_Type));
            New_Association
              (Assocs,
               New_Lit (New_Sizeof (Ghdl_Index_Type, Ghdl_Index_Type)));
            New_Procedure_Call (Assocs);
         end Translate_Rw_Length;

         Var : Mnode;
      begin
         Etype := Get_Type (Get_File_Type_Mark (File_Type));
         Tinfo := Get_Info (Etype);
         if Tinfo.Type_Mode in Type_Mode_Scalar then
            --  Intrinsic.
            return;
         end if;

         F_Info := Add_Info (Subprg, Kind_Subprg);
         --Chap2.Clear_Instance_Data (F_Info.Subprg_Instance);
         F_Info.Use_Stack2 := False;

         Id := Get_Identifier (Get_Type_Declarator (File_Type));
         Kind := Get_Implicit_Definition (Subprg);
         case Kind is
            when Iir_Predefined_Write =>
               Name := Create_Identifier (Id, "_WRITE");
            when Iir_Predefined_Read
              | Iir_Predefined_Read_Length =>
               Name := Create_Identifier (Id, "_READ");
            when others =>
               raise Internal_Error;
         end case;

         --  Create function.
         if Kind = Iir_Predefined_Read_Length then
            Start_Function_Decl
              (Inter_List, Name, Global_Storage, Std_Integer_Type_Node);
         else
            Start_Procedure_Decl (Inter_List, Name, Global_Storage);
         end if;
         Chap2.Create_Subprg_Instance (Inter_List, Subprg);

         New_Interface_Decl
           (Inter_List, Var_File, Get_Identifier ("FILE"),
            Ghdl_File_Index_Type);
         New_Interface_Decl
           (Inter_List, Var_Val, Get_Identifier ("VAL"),
            Tinfo.Ortho_Ptr_Type (Mode_Value));
         Finish_Subprogram_Decl (Inter_List, F_Info.Ortho_Func);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Start_Subprogram_Body (F_Info.Ortho_Func);
         Chap2.Start_Subprg_Instance_Use (Subprg);
         Push_Local_Factory;

         Var := Dp2M (Var_Val, Tinfo, Mode_Value);

         case Kind is
            when Iir_Predefined_Write =>
               if Tinfo.Type_Mode = Type_Mode_Fat_Array then
                  declare
                     Var_Max : O_Dnode;
                  begin
                     Open_Temp;
                     Var_Max := Create_Temp_Init
                       (Ghdl_Index_Type,
                        Chap3.Get_Array_Length (Var, Etype));
                     Translate_Rw_Length (Var_Max, Ghdl_Write_Scalar);
                     Translate_Rw_Array (Chap3.Get_Array_Base (Var), Etype,
                                         Var_Max, Ghdl_Write_Scalar);
                     Close_Temp;
                  end;
               else
                  Translate_Rw (Var, Etype, Ghdl_Write_Scalar);
               end if;
            when Iir_Predefined_Read =>
               Translate_Rw (Var, Etype, Ghdl_Read_Scalar);

            when Iir_Predefined_Read_Length =>
               declare
                  Var_Len : O_Dnode;
               begin
                  Open_Temp;
                  Var_Len := Create_Temp (Ghdl_Index_Type);
                  Translate_Rw_Length (Var_Len, Ghdl_Read_Scalar);

                  Chap6.Check_Bound_Error
                    (New_Compare_Op (ON_Gt,
                                     New_Obj_Value (Var_Len),
                                     Chap3.Get_Array_Length (Var, Etype),
                                     Ghdl_Bool_Type),
                     Subprg, 1);
                  Translate_Rw_Array (Chap3.Get_Array_Base (Var), Etype,
                                      Var_Len, Ghdl_Read_Scalar);
                  New_Return_Stmt (New_Convert_Ov (New_Obj_Value (Var_Len),
                                                   Std_Integer_Type_Node));
                  Close_Temp;
               end;
            when others =>
               raise Internal_Error;
         end case;
         Chap2.Finish_Subprg_Instance_Use (Subprg);
         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Translate_File_Subprogram;

      procedure Init_Implicit_Subprogram_Infos
        (Infos : out Implicit_Subprogram_Infos) is
      begin
         --  Be independant of declaration order since the same subprogram
         --  may be used for several implicit operators (eg. array comparaison)
         Infos.Arr_Eq_Info := null;
         Infos.Arr_Cmp_Info := null;
         Infos.Arr_Concat_Info := null;
         Infos.Rec_Eq_Info := null;
         Infos.Arr_Shl_Info := null;
         Infos.Arr_Sha_Info := null;
         Infos.Arr_Rot_Info := null;
      end Init_Implicit_Subprogram_Infos;

      procedure Translate_Implicit_Subprogram
        (Subprg : Iir; Infos : in out Implicit_Subprogram_Infos)
      is
         Kind : Iir_Predefined_Functions;
      begin
         Kind := Get_Implicit_Definition (Subprg);
         if Predefined_To_Onop (Kind) /= ON_Nil then
            --  Intrinsic.
            return;
         end if;

         case Kind is
            when Iir_Predefined_Access_Equality
              | Iir_Predefined_Access_Inequality =>
               --  Intrinsic.
               null;
            when Iir_Predefined_Deallocate =>
               --  Intrinsic.
               null;
            when Iir_Predefined_Integer_Identity
              | Iir_Predefined_Integer_Exp =>
               --  Intrinsic.
               null;

            when Iir_Predefined_Record_Equality
              | Iir_Predefined_Record_Inequality =>
               if Infos.Rec_Eq_Info = null then
                  Translate_Predefined_Record_Equality (Subprg);
                  Infos.Rec_Eq_Info := Get_Info (Subprg);
               else
                  Set_Info (Subprg, Infos.Rec_Eq_Info);
               end if;

            when Iir_Predefined_Array_Equality
              | Iir_Predefined_Array_Inequality =>
               if Infos.Arr_Eq_Info = null then
                  Translate_Predefined_Array_Equality (Subprg);
                  Infos.Arr_Eq_Info := Get_Info (Subprg);
               else
                  Set_Info (Subprg, Infos.Arr_Eq_Info);
               end if;

            when Iir_Predefined_Array_Greater
              | Iir_Predefined_Array_Greater_Equal
              | Iir_Predefined_Array_Less
              | Iir_Predefined_Array_Less_Equal =>
               if Infos.Arr_Cmp_Info = null then
                  Translate_Predefined_Array_Compare (Subprg);
                  Infos.Arr_Cmp_Info := Get_Info (Subprg);
               else
                  Set_Info (Subprg, Infos.Arr_Cmp_Info);
               end if;

            when Iir_Predefined_Array_Array_Concat
              | Iir_Predefined_Array_Element_Concat
              | Iir_Predefined_Element_Array_Concat
              | Iir_Predefined_Element_Element_Concat =>
               if Infos.Arr_Concat_Info = null then
                  Translate_Predefined_Array_Array_Concat (Subprg);
                  Infos.Arr_Concat_Info := Get_Info (Subprg);
               else
                  Set_Info (Subprg, Infos.Arr_Concat_Info);
               end if;

            when Iir_Predefined_TF_Array_And
              | Iir_Predefined_TF_Array_Or
              | Iir_Predefined_TF_Array_Nand
              | Iir_Predefined_TF_Array_Nor
              | Iir_Predefined_TF_Array_Xor
              | Iir_Predefined_TF_Array_Xnor
              | Iir_Predefined_TF_Array_Not =>
               Translate_Predefined_Array_Logical (Subprg);

            when Iir_Predefined_Array_Sll
              | Iir_Predefined_Array_Srl =>
               if Infos.Arr_Shl_Info = null then
                  Translate_Predefined_Array_Shift (Subprg);
                  Infos.Arr_Shl_Info := Get_Info (Subprg);
               else
                  Set_Info (Subprg, Infos.Arr_Shl_Info);
               end if;

            when Iir_Predefined_Array_Sla
              | Iir_Predefined_Array_Sra =>
               if Infos.Arr_Sha_Info = null then
                  Translate_Predefined_Array_Shift (Subprg);
                  Infos.Arr_Sha_Info := Get_Info (Subprg);
               else
                  Set_Info (Subprg, Infos.Arr_Sha_Info);
               end if;

            when Iir_Predefined_Array_Rol
              | Iir_Predefined_Array_Ror =>
               if Infos.Arr_Rot_Info = null then
                  Translate_Predefined_Array_Shift (Subprg);
                  Infos.Arr_Rot_Info := Get_Info (Subprg);
               else
                  Set_Info (Subprg, Infos.Arr_Rot_Info);
               end if;

            when Iir_Predefined_Physical_Identity =>
               null;

            when Iir_Predefined_Physical_Integer_Mul
              | Iir_Predefined_Physical_Integer_Div
              | Iir_Predefined_Integer_Physical_Mul
              | Iir_Predefined_Physical_Real_Mul
              | Iir_Predefined_Physical_Real_Div
              | Iir_Predefined_Real_Physical_Mul
              | Iir_Predefined_Physical_Physical_Div =>
               null;

            when Iir_Predefined_Floating_Exp
              | Iir_Predefined_Floating_Identity =>
               null;

            when Iir_Predefined_File_Open
              | Iir_Predefined_File_Open_Status
              | Iir_Predefined_File_Close
              | Iir_Predefined_Endfile =>
               --  All of them have predefined definitions.
               null;

            when Iir_Predefined_Write
              | Iir_Predefined_Read_Length
              | Iir_Predefined_Read =>
               declare
                  Param : Iir;
                  File_Type : Iir;
               begin
                  Param := Get_Interface_Declaration_Chain (Subprg);
                  File_Type := Get_Type (Param);
                  if not Get_Text_File_Flag (File_Type) then
                     Translate_File_Subprogram (Subprg, File_Type);
                  end if;
               end;

            when Iir_Predefined_Now_Function =>
               null;

            when others =>
               Error_Kind ("translate_implicit_subprogram ("
                           & Iir_Predefined_Functions'Image (Kind) & ")",
                           Subprg);
         end case;
      end Translate_Implicit_Subprogram;
   end Chap7;

   package body Chap8 is
      procedure Translate_Return_Statement (Stmt : Iir_Return_Statement)
      is
         Expr : Iir;
         Ret_Type : Iir;
         Ret_Info : Type_Info_Acc;
         Val : O_Dnode;
         Area : Mnode;
         Subprg_Info : Ortho_Info_Acc;

         procedure Gen_Return is
         begin
            if Subprg_Info.Subprg_Exit /= O_Snode_Null then
               New_Exit_Stmt (Subprg_Info.Subprg_Exit);
            else
               New_Return_Stmt;
            end if;
         end Gen_Return;

         procedure Gen_Return_Value (Val : O_Enode) is
         begin
            if Subprg_Info.Subprg_Exit /= O_Snode_Null then
               New_Assign_Stmt (New_Obj (Subprg_Info.Subprg_Result), Val);
               New_Exit_Stmt (Subprg_Info.Subprg_Exit);
            else
               New_Return_Stmt (Val);
            end if;
         end Gen_Return_Value;
      begin
         Subprg_Info := Get_Info (Chap2.Current_Subprogram);

         Expr := Get_Expression (Stmt);
         if Expr = Null_Iir then
            --  Return in a procedure.
            Gen_Return;
            return;
         end if;

         --  Return in a function.
         Ret_Type := Get_Return_Type (Chap2.Current_Subprogram);
         Ret_Info := Get_Info (Ret_Type);
         case Ret_Info.Type_Mode is
            when Type_Mode_Scalar =>
               --  * if the return type is scalar, simply returns.
               declare
                  V : O_Dnode;
                  R : O_Enode;
               begin
                  --  Always uses a temporary in case of the return expression
                  --  uses secondary stack.
                  --  FIXME: don't use the temp if not required.
                  R := Chap7.Translate_Expression (Expr, Ret_Type);
                  if Has_Stack2_Mark
                    or else Chap3.Need_Range_Check (Expr, Ret_Type)
                  then
                     V := Create_Temp (Ret_Info.Ortho_Type (Mode_Value));
                     New_Assign_Stmt (New_Obj (V), R);
                     Stack2_Release;
                     Chap3.Check_Range (V, Expr, Ret_Type, Expr);
                     Gen_Return_Value (New_Obj_Value (V));
                  else
                     Gen_Return_Value (R);
                  end if;
               end;
            when Type_Mode_Acc =>
               --  * access: thin and no range.
               declare
                  Res : O_Enode;
               begin
                  Res := Chap7.Translate_Expression (Expr, Ret_Type);
                  Gen_Return_Value (Res);
               end;
            when Type_Mode_Fat_Array =>
               --  * if the return type is unconstrained: allocate an area from
               --    the secondary stack, copy it to the area, and fill the fat
               --    pointer.
               --  Evaluate the result.
               Area := Dp2M (Subprg_Info.Res_Interface, Ret_Info, Mode_Value);
               Val := Create_Temp_Init
                 (Ret_Info.Ortho_Ptr_Type (Mode_Value),
                  Chap7.Translate_Expression (Expr, Ret_Type));
               Chap3.Translate_Object_Allocation
                 (Area, Alloc_Return, Ret_Type,
                  Chap3.Get_Array_Ptr_Bounds_Ptr
                  (New_Obj (Val), Ret_Type, Mode_Value));
               Chap3.Translate_Object_Copy
                 (Area, New_Obj_Value (Val), Ret_Type);
               Gen_Return;
            when Type_Mode_Record
              | Type_Mode_Array
              | Type_Mode_Fat_Acc =>
               --  * if the return type is a constrained composite type, copy
               --    it to the result area.
               --  Create a temporary area so that if the expression use
               --  stack2, it will be freed before the return (otherwise,
               --  the stack area will be lost).
               declare
                  V : Mnode;
               begin
                  Open_Temp;
                  V := Dp2M (Subprg_Info.Res_Interface, Ret_Info, Mode_Value);
                  Chap3.Translate_Object_Copy
                    (V, Chap7.Translate_Expression (Expr, Ret_Type), Ret_Type);
                  Close_Temp;
                  Gen_Return;
               end;
            when Type_Mode_File =>
               --  FIXME: Is it possible ?
               Error_Kind ("translate_return_statement", Ret_Type);
            when Type_Mode_Unknown
              | Type_Mode_Protected =>
               raise Internal_Error;
         end case;
      end Translate_Return_Statement;

      procedure Translate_If_Statement (Stmt : Iir)
      is
         Blk : O_If_Block;
         Else_Clause : Iir;
      begin
         Start_If_Stmt
           (Blk, Chap7.Translate_Expression (Get_Condition (Stmt)));

         Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));

         Else_Clause := Get_Else_Clause (Stmt);
         if Else_Clause /= Null_Iir then
            New_Else_Stmt (Blk);
            if Get_Condition (Else_Clause) = Null_Iir then
               Translate_Statements_Chain
                 (Get_Sequential_Statement_Chain (Else_Clause));
            else
               Open_Temp;
               Translate_If_Statement (Else_Clause);
               Close_Temp;
            end if;
         end if;
         Finish_If_Stmt (Blk);
      end Translate_If_Statement;

      function Get_Range_Ptr_Field_Value (O_Range : O_Lnode; Field : O_Fnode)
        return O_Enode
      is
      begin
         return New_Value (New_Selected_Element
                           (New_Access_Element (New_Value (O_Range)), Field));
      end Get_Range_Ptr_Field_Value;

      --  Inc or dec ITERATOR according to DIR.
      procedure Gen_Update_Iterator (Iterator : O_Dnode;
                                     Dir : Iir_Direction;
                                     Val : Unsigned_64;
                                     Itype : Iir)
      is
         Op : ON_Op_Kind;
         Base_Type : Iir;
         V : O_Enode;
      begin
         case Dir is
            when Iir_To =>
               Op := ON_Add_Ov;
            when Iir_Downto =>
               Op := ON_Sub_Ov;
         end case;
         Base_Type := Get_Base_Type (Itype);
         case Get_Kind (Base_Type) is
            when Iir_Kind_Integer_Type_Definition =>
               V := New_Lit
                 (New_Signed_Literal
                  (Get_Ortho_Type (Base_Type, Mode_Value), Integer_64 (Val)));
            when Iir_Kind_Enumeration_Type_Definition =>
               declare
                  List : Iir_List;
               begin
                  List := Get_Enumeration_Literal_List (Base_Type);
                  --  FIXME: what about type E is ('T') ??
                  if Natural (Val) > Get_Nbr_Elements (List) then
                     raise Internal_Error;
                  end if;
                  V := New_Lit
                    (Get_Ortho_Expr (Get_Nth_Element (List, Natural (Val))));
               end;

            when others =>
               Error_Kind ("gen_update_iterator", Base_Type);
         end case;
         New_Assign_Stmt (New_Obj (Iterator),
                          New_Dyadic_Op (Op, New_Obj_Value (Iterator), V));
      end Gen_Update_Iterator;

      type For_Loop_Data is record
         Iterator : Iir_Iterator_Declaration;
         Stmt : Iir_For_Loop_Statement;
         --  If around the loop, to check if the loop must be executed.
         If_Blk : O_If_Block;
         Label_Next, Label_Exit : O_Snode;
         --  Right bound of the iterator, used only if the iterator is a
         --  range expression.
         O_Right : O_Dnode;
         --  Range variable of the iterator, used only if the iterator is not
         --  a range expression.
         O_Range : O_Dnode;
      end record;

      procedure Start_For_Loop (Iterator : Iir_Iterator_Declaration;
                                Stmt : Iir_For_Loop_Statement;
                                Data : out For_Loop_Data)
      is
         Iter_Type : Iir;
         Iter_Base_Type : Iir;
         Var_Iter : Var_Acc;
         Constraint : Iir;
         Cond : O_Enode;
         Dir : Iir_Direction;
         Iter_Type_Info : Ortho_Info_Acc;
         Op : ON_Op_Kind;
      begin
         --  Initialize DATA.
         Data.Iterator := Iterator;
         Data.Stmt := Stmt;

         Iter_Type := Get_Type (Iterator);
         Iter_Base_Type := Get_Base_Type (Iter_Type);
         Iter_Type_Info := Get_Info (Iter_Base_Type);
         Var_Iter := Get_Info (Iterator).Iterator_Var;

         Open_Temp;

         Constraint := Get_Range_Constraint (Iter_Type);
         if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
            New_Assign_Stmt
              (Get_Var (Var_Iter), Chap7.Translate_Range_Expression_Left
               (Constraint, Iter_Base_Type));
            Dir := Get_Direction (Constraint);
            Data.O_Right := Create_Temp
              (Iter_Type_Info.Ortho_Type (Mode_Value));
            New_Assign_Stmt
              (New_Obj (Data.O_Right), Chap7.Translate_Range_Expression_Right
               (Constraint, Iter_Base_Type));
            case Dir is
               when Iir_To =>
                  Op := ON_Le;
               when Iir_Downto =>
                  Op := ON_Ge;
            end case;
            --  Check for at least one iteration.
            Cond := New_Compare_Op
              (Op, New_Value (Get_Var (Var_Iter)),
               New_Obj_Value (Data.O_Right),
               Ghdl_Bool_Type);
         else
            Data.O_Range := Create_Temp (Iter_Type_Info.T.Range_Ptr_Type);
            New_Assign_Stmt (New_Obj (Data.O_Range),
                             New_Address (Chap7.Translate_Range
                                          (Constraint, Iter_Base_Type),
                                          Iter_Type_Info.T.Range_Ptr_Type));
            New_Assign_Stmt
              (Get_Var (Var_Iter), Get_Range_Ptr_Field_Value
               (New_Obj (Data.O_Range), Iter_Type_Info.T.Range_Left));
            --  Before starting the loop, check wether there will be at least
            --  one iteration.
            Cond := New_Compare_Op
              (ON_Gt,
               Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range),
                                          Iter_Type_Info.T.Range_Length),
               New_Lit (Ghdl_Index_0),
               Ghdl_Bool_Type);
         end if;

         Start_If_Stmt (Data.If_Blk, Cond);

         --  Start loop.
         --  There are two blocks: one for the exit, one for the next.
         Start_Loop_Stmt (Data.Label_Exit);
         Start_Loop_Stmt (Data.Label_Next);

         if Stmt /= Null_Iir then
            declare
               Loop_Info : Loop_Info_Acc;
            begin
               Loop_Info := Add_Info (Stmt, Kind_Loop);
               Loop_Info.Label_Exit := Data.Label_Exit;
               Loop_Info.Label_Next := Data.Label_Next;
            end;
         end if;
      end Start_For_Loop;

      procedure Finish_For_Loop (Data : in out For_Loop_Data)
      is
         Cond : O_Enode;
         If_Blk1 : O_If_Block;
         Iter_Type : Iir;
         Iter_Base_Type : Iir;
         Iter_Type_Info : Type_Info_Acc;
         Var_Iter : Var_Acc;
         Constraint : Iir;
         Deep_Rng : Iir;
         Deep_Reverse : Boolean;
      begin
         New_Exit_Stmt (Data.Label_Next);
         Finish_Loop_Stmt (Data.Label_Next);

         --  Check end of loop.
         --  Equality is necessary and enough.
         Iter_Type := Get_Type (Data.Iterator);
         Iter_Base_Type := Get_Base_Type (Iter_Type);
         Iter_Type_Info := Get_Info (Iter_Base_Type);
         Var_Iter := Get_Info (Data.Iterator).Iterator_Var;

         Constraint := Get_Range_Constraint (Iter_Type);

         if Get_Kind (Constraint) = Iir_Kind_Range_Expression then
            Cond := New_Obj_Value (Data.O_Right);
         else
            Cond := Get_Range_Ptr_Field_Value
              (New_Obj (Data.O_Range), Iter_Type_Info.T.Range_Right);
         end if;
         Gen_Exit_When (Data.Label_Exit,
                        New_Compare_Op (ON_Eq, New_Value (Get_Var (Var_Iter)),
                                        Cond, Ghdl_Bool_Type));

         --  Update the iterator.
         Chap6.Get_Deep_Range_Expression (Iter_Type, Deep_Rng, Deep_Reverse);
         if Deep_Rng /= Null_Iir then
            if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then
               Gen_Update_Iterator
                 (Get_Var_Label (Var_Iter), Iir_To, 1, Iter_Base_Type);
            else
               Gen_Update_Iterator
                 (Get_Var_Label (Var_Iter), Iir_Downto, 1, Iter_Base_Type);
            end if;
         else
            Start_If_Stmt
              (If_Blk1, New_Compare_Op
               (ON_Eq,
                Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range),
                                           Iter_Type_Info.T.Range_Dir),
                New_Lit (Ghdl_Dir_To_Node),
                Ghdl_Bool_Type));
            Gen_Update_Iterator
              (Get_Var_Label (Var_Iter), Iir_To, 1, Iter_Base_Type);
            New_Else_Stmt (If_Blk1);
            Gen_Update_Iterator
              (Get_Var_Label (Var_Iter), Iir_Downto, 1, Iter_Base_Type);
            Finish_If_Stmt (If_Blk1);
         end if;

         Finish_Loop_Stmt (Data.Label_Exit);
         Finish_If_Stmt (Data.If_Blk);
         Close_Temp;

         if Data.Stmt /= Null_Iir then
            Free_Info (Data.Stmt);
         end if;
      end Finish_For_Loop;

      Current_Loop : Iir := Null_Iir;

      procedure Translate_For_Loop_Statement (Stmt : Iir_For_Loop_Statement)
      is
         Iterator : constant Iir := Get_Parameter_Specification (Stmt);
         Iter_Type : constant Iir := Get_Type (Iterator);
         Iter_Base_Type : constant Iir := Get_Base_Type (Iter_Type);
         Iter_Type_Info : constant Type_Info_Acc := Get_Info (Iter_Base_Type);
         Data : For_Loop_Data;
         It_Info : Ortho_Info_Acc;
         Var_Iter : Var_Acc;
         Prev_Loop : Iir;
      begin
         Prev_Loop := Current_Loop;
         Current_Loop := Stmt;
         Start_Declare_Stmt;

         Chap3.Translate_Object_Subtype (Iterator, False);

         --  Create info for the iterator.
         It_Info := Add_Info (Iterator, Kind_Iterator);
         Var_Iter := Create_Var
           (Create_Var_Identifier (Iterator),
            Iter_Type_Info.Ortho_Type (Mode_Value),
            O_Storage_Local);
         It_Info.Iterator_Var := Var_Iter;

         Start_For_Loop (Iterator, Stmt, Data);

         Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));

         Finish_For_Loop (Data);

         Finish_Declare_Stmt;

         Free_Info (Iterator);
         Current_Loop := Prev_Loop;
      end Translate_For_Loop_Statement;

      procedure Translate_While_Loop_Statement
        (Stmt : Iir_While_Loop_Statement)
      is
         Info : Loop_Info_Acc;
         Cond : Iir;
         Prev_Loop : Iir;
      begin
         Prev_Loop := Current_Loop;
         Current_Loop := Stmt;

         Info := Add_Info (Stmt, Kind_Loop);

         Start_Loop_Stmt (Info.Label_Exit);
         Info.Label_Next := O_Snode_Null;

         Open_Temp;
         Cond := Get_Condition (Stmt);
         if Cond /= Null_Iir then
            Gen_Exit_When
              (Info.Label_Exit,
               New_Monadic_Op (ON_Not, Chap7.Translate_Expression (Cond)));
         end if;
         Close_Temp;

         Translate_Statements_Chain (Get_Sequential_Statement_Chain (Stmt));

         Finish_Loop_Stmt (Info.Label_Exit);
         Free_Info (Stmt);
         Current_Loop := Prev_Loop;
      end Translate_While_Loop_Statement;

      procedure Translate_Exit_Next_Statement (Stmt : Iir)
      is
         Cond : constant Iir := Get_Condition (Stmt);
         If_Blk : O_If_Block;
         Info : Loop_Info_Acc;
         Loop_Label : Iir;
         Loop_Stmt : Iir;
      begin
         if Cond /= Null_Iir then
            Start_If_Stmt (If_Blk, Chap7.Translate_Expression (Cond));
         end if;

         Loop_Label := Get_Loop_Label (Stmt);
         if Loop_Label = Null_Iir then
            Loop_Stmt := Current_Loop;
         else
            Loop_Stmt := Get_Named_Entity (Loop_Label);
         end if;

         Info := Get_Info (Loop_Stmt);
         case Get_Kind (Stmt) is
            when Iir_Kind_Exit_Statement =>
               New_Exit_Stmt (Info.Label_Exit);
            when Iir_Kind_Next_Statement =>
               if Info.Label_Next /= O_Snode_Null then
                  --  For-loop.
                  New_Exit_Stmt (Info.Label_Next);
               else
                  --  While-loop.
                  New_Next_Stmt (Info.Label_Exit);
               end if;
            when others =>
               raise Internal_Error;
         end case;
         if Cond /= Null_Iir then
            Finish_If_Stmt (If_Blk);
         end if;
      end Translate_Exit_Next_Statement;

      procedure Translate_Variable_Aggregate_Assignment
        (Targ : Iir; Targ_Type : Iir; Val : Mnode);

      procedure Translate_Variable_Array_Aggr
        (Targ : Iir_Aggregate;
         Targ_Type : Iir;
         Val : Mnode;
         Index : in out Unsigned_64;
         Dim : Natural)
      is
         El : Iir;
         Final : Boolean;
         El_Type : Iir;
      begin
         Final := Dim = Get_Nbr_Elements (Get_Index_Subtype_List (Targ_Type));
         if Final then
            El_Type := Get_Element_Subtype (Targ_Type);
         end if;
         El := Get_Association_Choices_Chain (Targ);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Choice_By_None =>
                  if Final then
                     Translate_Variable_Aggregate_Assignment
                       (Get_Associated (El), El_Type,
                        Chap3.Index_Base
                        (Val, Targ_Type,
                         New_Lit (New_Unsigned_Literal
                                  (Ghdl_Index_Type, Index))));
                     Index := Index + 1;
                  else
                     Translate_Variable_Array_Aggr
                       (Get_Associated (El), Targ_Type, Val, Index, Dim + 1);
                  end if;
               when others =>
                  Error_Kind ("translate_variable_array_aggr", El);
            end case;
            El := Get_Chain (El);
         end loop;
      end Translate_Variable_Array_Aggr;

      procedure Translate_Variable_Rec_Aggr
        (Targ : Iir_Aggregate; Targ_Type : Iir; Val : Mnode)
      is
         Aggr_El : Iir;
         El_List : Iir_List;
         El_Index : Natural;
         Elem : Iir;
      begin
         El_List := Get_Elements_Declaration_List (Get_Base_Type (Targ_Type));
         El_Index := 0;
         Aggr_El := Get_Association_Choices_Chain (Targ);
         while Aggr_El /= Null_Iir loop
            case Get_Kind (Aggr_El) is
               when Iir_Kind_Choice_By_None =>
                  Elem := Get_Nth_Element (El_List, El_Index);
                  El_Index := El_Index + 1;
               when Iir_Kind_Choice_By_Name =>
                  Elem := Get_Name (Aggr_El);
               when others =>
                  Error_Kind ("translate_variable_rec_aggr", Aggr_El);
            end case;
            Translate_Variable_Aggregate_Assignment
              (Get_Associated (Aggr_El), Get_Type (Elem),
               Chap6.Translate_Selected_Element (Val, Elem));
            Aggr_El := Get_Chain (Aggr_El);
         end loop;
      end Translate_Variable_Rec_Aggr;

      procedure Translate_Variable_Aggregate_Assignment
        (Targ : Iir; Targ_Type : Iir; Val : Mnode)
      is
         Index : Unsigned_64;
      begin
         if Get_Kind (Targ) = Iir_Kind_Aggregate then
            case Get_Kind (Targ_Type) is
               when Iir_Kinds_Array_Type_Definition =>
                  Index := 0;
                  Translate_Variable_Array_Aggr
                    (Targ, Targ_Type, Val, Index, 1);
               when Iir_Kind_Record_Type_Definition
                 | Iir_Kind_Record_Subtype_Definition =>
                  Translate_Variable_Rec_Aggr (Targ, Targ_Type, Val);
               when others =>
                  Error_Kind
                    ("translate_variable_aggregate_assignment", Targ_Type);
            end case;
         else
            declare
               Targ_Node : Mnode;
            begin
               Targ_Node := Chap6.Translate_Name (Targ);
               Chap3.Translate_Object_Copy (Targ_Node, M2E (Val), Targ_Type);
            end;
         end if;
      end Translate_Variable_Aggregate_Assignment;

      procedure Translate_Variable_Assignment_Statement
        (Stmt : Iir_Variable_Assignment_Statement)
      is
         Target : constant Iir := Get_Target (Stmt);
         Targ_Type : constant Iir := Get_Type (Target);
         Expr : constant Iir := Get_Expression (Stmt);
         Targ_Node : Mnode;
      begin
         if Get_Kind (Target) = Iir_Kind_Aggregate then
            declare
               E : O_Enode;
               Temp : Mnode;
            begin
               Chap3.Translate_Anonymous_Type_Definition (Targ_Type, True);

               --  Use a temporary variable, to avoid overlap.
               Temp := Create_Temp (Get_Info (Targ_Type));
               Chap4.Allocate_Complex_Object (Targ_Type, Alloc_Stack, Temp);

               E := Chap7.Translate_Expression (Expr, Targ_Type);
               Chap3.Translate_Object_Copy (Temp, E, Targ_Type);
               Translate_Variable_Aggregate_Assignment
                 (Target, Targ_Type, Temp);
               return;
            end;
         else
            Targ_Node := Chap6.Translate_Name (Target);
            if Get_Kind (Expr) = Iir_Kind_Aggregate then
               declare
                  E : O_Enode;
               begin
                  E := Chap7.Translate_Expression (Expr, Targ_Type);
                  Chap3.Translate_Object_Copy (Targ_Node, E, Targ_Type);
               end;
            else
               Chap7.Translate_Assign (Targ_Node, Expr, Targ_Type);
            end if;
         end if;
      end Translate_Variable_Assignment_Statement;

      procedure Translate_Report (Stmt : Iir; Subprg : O_Dnode; Level : Iir)
      is
         Expr : Iir;
         Msg : O_Enode;
         Severity : O_Enode;
         Assocs : O_Assoc_List;
         Loc : O_Dnode;
         Rti : O_Cnode;
      begin
         Loc := Chap4.Get_Location (Stmt);
         Expr := Get_Report_Expression (Stmt);
         if Expr = Null_Iir then
            Msg := New_Lit (New_Null_Access (Std_String_Ptr_Node));
         else
            Msg := Chap7.Translate_Expression (Expr, String_Type_Definition);
         end if;
         Expr := Get_Severity_Expression (Stmt);
         if Expr = Null_Iir then
            Severity := New_Lit (Get_Ortho_Expr (Level));
         else
            Severity := Chap7.Translate_Expression (Expr);
         end if;
         --  Do call.
         Start_Association (Assocs, Subprg);
         New_Association (Assocs, Msg);
         New_Association (Assocs, Severity);
         New_Association (Assocs, New_Address (New_Obj (Loc),
                                               Ghdl_Location_Ptr_Node));
         if Current_Library_Unit /= Null_Iir
           and then Get_Kind (Current_Library_Unit) = Iir_Kind_Package_Body
         then
            Rti := Rtis.New_Rti_Address
              (Get_Info
                 (Get_Package (Current_Library_Unit)).Package_Rti_Const);
         else
            Rti := New_Null_Access (Rtis.Ghdl_Rti_Access);
         end if;
         New_Association (Assocs, New_Lit (Rti));
         New_Procedure_Call (Assocs);
      end Translate_Report;

      procedure Translate_Assertion_Statement (Stmt : Iir_Assertion_Statement)
      is
         Expr : Iir;
         If_Blk : O_If_Block;
      begin
         Expr := Get_Assertion_Condition (Stmt);
         if Get_Expr_Staticness (Expr) = Locally then
            if Eval_Pos (Expr) = 1 then
               --  Assert TRUE is a noop.
               --  FIXME: generate a noop ?
               return;
            end if;
            Translate_Report (Stmt, Ghdl_Assert_Failed, Severity_Level_Error);
         else
            --  An assertion is reported if the condition is false!
            Start_If_Stmt (If_Blk,
                           New_Monadic_Op (ON_Not,
                                           Chap7.Translate_Expression (Expr)));
            --  Note: it is necessary to create a declare block, to avoid bad
            --  order with the if block.
            Open_Temp;
            Translate_Report (Stmt, Ghdl_Assert_Failed, Severity_Level_Error);
            Close_Temp;
            Finish_If_Stmt (If_Blk);
         end if;
      end Translate_Assertion_Statement;

      procedure Translate_Report_Statement (Stmt : Iir_Report_Statement) is
      begin
         Translate_Report (Stmt, Ghdl_Report, Severity_Level_Note);
      end Translate_Report_Statement;

      --  Helper to compare a string choice with the selector.
      function Translate_Simple_String_Choice
        (Expr : O_Dnode;
         Val : O_Enode;
         Val_Node : O_Dnode;
         Tinfo : Type_Info_Acc;
         Func : Iir)
        return O_Enode
      is
         Assoc : O_Assoc_List;
         Func_Info : Subprg_Info_Acc;
      begin
         New_Assign_Stmt
           (New_Selected_Element (New_Obj (Val_Node),
                                  Tinfo.T.Base_Field (Mode_Value)),
            Val);
         Func_Info := Get_Info (Func);
         Start_Association (Assoc, Func_Info.Ortho_Func);
         Chap2.Add_Subprg_Instance_Assoc (Assoc, Func_Info.Subprg_Instance);
         New_Association (Assoc, New_Obj_Value (Expr));
         New_Association
           (Assoc, New_Address (New_Obj (Val_Node),
                                Tinfo.Ortho_Ptr_Type (Mode_Value)));
         return New_Function_Call (Assoc);
      end Translate_Simple_String_Choice;

      --  Helper to evaluate the selector and preparing a choice variable.
      procedure Translate_String_Case_Statement_Common
        (Stmt : Iir_Case_Statement;
         Expr_Type : out Iir;
         Tinfo : out Type_Info_Acc;
         Expr_Node : out O_Dnode;
         C_Node : out O_Dnode)
      is
         Expr : Iir;
         Base_Type : Iir;
      begin
         --  Translate into if/elsif statements.
         --  FIXME: if the number of literals ** length of the array < 256,
         --   use a case statement.
         Expr := Get_Expression (Stmt);
         Expr_Type := Get_Type (Expr);
         Base_Type := Get_Base_Type (Expr_Type);
         Tinfo := Get_Info (Base_Type);

         --  Translate selector.
         Expr_Node := Create_Temp_Init
           (Tinfo.Ortho_Ptr_Type (Mode_Value),
            Chap7.Translate_Expression (Expr, Base_Type));

         --  Copy the bounds for the choices.
         C_Node := Create_Temp (Tinfo.Ortho_Type (Mode_Value));
         New_Assign_Stmt
           (New_Selected_Element (New_Obj (C_Node),
                                  Tinfo.T.Bounds_Field (Mode_Value)),
            New_Value_Selected_Acc_Value
              (New_Obj (Expr_Node), Tinfo.T.Bounds_Field (Mode_Value)));
      end Translate_String_Case_Statement_Common;

      --  Translate a string case statement using a dichotomy.
      procedure Translate_String_Case_Statement_Dichotomy
        (Stmt : Iir_Case_Statement)
      is
         --  Selector.
         Expr_Type : Iir;
         Tinfo : Type_Info_Acc;
         Expr_Node : O_Dnode;
         C_Node : O_Dnode;

         Choices_Chain : Iir;
         Choice : Iir;
         Has_Others : Boolean;
         Func : Iir;

         --  Number of non-others choices.
         Nbr_Choices : Natural;
         --  Number of associations.
         Nbr_Assocs : Natural;

         Info : Ortho_Info_Acc;
         First, Last : Ortho_Info_Acc;
         Sel_Length : Iir_Int64;

         --  Dichotomy table (table of choices).
         String_Type : O_Tnode;
         Table_Base_Type : O_Tnode;
         Table_Type : O_Tnode;
         Table : O_Dnode;
         List : O_Array_Aggr_List;
         Table_Cst : O_Cnode;

         --  Association table.
         --  Indexed by the choice, returns an index to the associated
         --   statement list.
         --  Could be replaced by jump table.
         Assoc_Table_Base_Type : O_Tnode;
         Assoc_Table_Type : O_Tnode;
         Assoc_Table : O_Dnode;
      begin
         Choices_Chain := Get_Case_Statement_Alternative_Chain (Stmt);

         --  Count number of choices and number of associations.
         Nbr_Choices := 0;
         Nbr_Assocs := 0;
         Choice := Choices_Chain;
         First := null;
         Last := null;
         Has_Others := False;
         while Choice /= Null_Iir loop
            case Get_Kind (Choice) is
               when Iir_Kind_Choice_By_Others =>
                  Has_Others := True;
                  exit;
               when Iir_Kind_Choice_By_Expression =>
                  null;
               when others =>
                  raise Internal_Error;
            end case;
            if not Get_Same_Alternative_Flag (Choice) then
               Nbr_Assocs := Nbr_Assocs + 1;
            end if;
            Info := Add_Info (Choice, Kind_Str_Choice);
            if First = null then
               First := Info;
            else
               Last.Choice_Chain := Info;
            end if;
            Last := Info;
            Info.Choice_Chain := null;
            Info.Choice_Assoc := Nbr_Assocs - 1;
            Info.Choice_Parent := Choice;
            Info.Choice_Expr := Get_Expression (Choice);

            Nbr_Choices := Nbr_Choices + 1;
            Choice := Get_Chain (Choice);
         end loop;

         --  Sort choices.
         declare
            procedure Merge_Sort (Head : Ortho_Info_Acc;
                                  Nbr : Natural;
                                  Res : out Ortho_Info_Acc;
                                  Next : out Ortho_Info_Acc)
            is
               L, R, L_End, R_End : Ortho_Info_Acc;
               E, Last : Ortho_Info_Acc;
               Half : constant Natural := Nbr / 2;
            begin
               --  Sorting less than 2 elements is easy!
               if Nbr < 2 then
                  Res := Head;
                  if Nbr = 0 then
                     Next := Head;
                  else
                     Next := Head.Choice_Chain;
                  end if;
                  return;
               end if;

               Merge_Sort (Head, Half, L, L_End);
               Merge_Sort (L_End, Nbr - Half, R, R_End);
               Next := R_End;

               --  Merge
               Last := null;
               loop
                  if L /= L_End
                    and then
                    (R = R_End
                       or else
                       Compare_String_Literals (L.Choice_Expr, R.Choice_Expr)
                       = Compare_Lt)
                  then
                     E := L;
                     L := L.Choice_Chain;
                  elsif R /= R_End then
                     E := R;
                     R := R.Choice_Chain;
                  else
                     exit;
                  end if;
                  if Last = null then
                     Res := E;
                  else
                     Last.Choice_Chain := E;
                  end if;
                  Last := E;
               end loop;
               Last.Choice_Chain := R_End;
            end Merge_Sort;
            Next : Ortho_Info_Acc;
         begin
            Merge_Sort (First, Nbr_Choices, First, Next);
            if Next /= null then
               raise Internal_Error;
            end if;
         end;

         Translate_String_Case_Statement_Common
           (Stmt, Expr_Type, Tinfo, Expr_Node, C_Node);

         --  Generate choices table.
         Sel_Length := Eval_Discrete_Type_Length
           (Get_String_Type_Bound_Type (Expr_Type));
         String_Type := New_Constrained_Array_Type
           (Tinfo.T.Base_Type (Mode_Value),
            New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Sel_Length)));
         Table_Base_Type := New_Array_Type (String_Type, Ghdl_Index_Type);
         New_Type_Decl (Create_Uniq_Identifier, Table_Base_Type);
         Table_Type := New_Constrained_Array_Type
           (Table_Base_Type,
            New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Choices)));
         New_Type_Decl (Create_Uniq_Identifier, Table_Type);
         New_Const_Decl (Table, Create_Uniq_Identifier, O_Storage_Private,
                         Table_Type);
         Start_Const_Value (Table);
         Start_Array_Aggr (List, Table_Type);
         Info := First;
         while Info /= null loop
            New_Array_Aggr_El (List, Chap7.Translate_Static_Expression
                                 (Info.Choice_Expr, Expr_Type));
            Info := Info.Choice_Chain;
         end loop;
         Finish_Array_Aggr (List, Table_Cst);
         Finish_Const_Value (Table, Table_Cst);

         --  Generate assoc table.
         Assoc_Table_Base_Type :=
           New_Array_Type (Ghdl_Index_Type, Ghdl_Index_Type);
         New_Type_Decl (Create_Uniq_Identifier, Assoc_Table_Base_Type);
         Assoc_Table_Type := New_Constrained_Array_Type
           (Assoc_Table_Base_Type,
            New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Choices)));
         New_Type_Decl (Create_Uniq_Identifier, Assoc_Table_Type);
         New_Const_Decl (Assoc_Table, Create_Uniq_Identifier,
                         O_Storage_Private, Assoc_Table_Type);
         Start_Const_Value (Assoc_Table);
         Start_Array_Aggr (List, Assoc_Table_Type);
         Info := First;
         while Info /= null loop
            New_Array_Aggr_El
              (List, New_Unsigned_Literal (Ghdl_Index_Type,
                                           Unsigned_64 (Info.Choice_Assoc)));
            Info := Info.Choice_Chain;
         end loop;
         Finish_Array_Aggr (List, Table_Cst);
         Finish_Const_Value (Assoc_Table, Table_Cst);

         --  Generate dichotomy code.
         declare
            Var_Lo, Var_Hi, Var_Mid : O_Dnode;
            Var_Cmp : O_Dnode;
            Var_Idx : O_Dnode;
            Label : O_Snode;
            Others_Lit : O_Cnode;
            If_Blk1, If_Blk2 : O_If_Block;
            Case_Blk : O_Case_Block;
         begin
            Var_Idx := Create_Temp (Ghdl_Index_Type);

            Start_Declare_Stmt;

            New_Var_Decl (Var_Lo, Wki_Lo, O_Storage_Local, Ghdl_Index_Type);
            New_Var_Decl (Var_Hi, Wki_Hi, O_Storage_Local, Ghdl_Index_Type);
            New_Var_Decl (Var_Mid, Wki_Mid, O_Storage_Local, Ghdl_Index_Type);
            New_Var_Decl (Var_Cmp, Wki_Cmp,
                          O_Storage_Local, Ghdl_Compare_Type);

            New_Assign_Stmt (New_Obj (Var_Lo), New_Lit (Ghdl_Index_0));
            New_Assign_Stmt
              (New_Obj (Var_Hi),
               New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
                                              Unsigned_64 (Nbr_Choices))));

            Func := Chap7.Find_Predefined_Function
              (Get_Base_Type (Expr_Type), Iir_Predefined_Array_Greater);

            if Has_Others then
               Others_Lit := New_Unsigned_Literal
                 (Ghdl_Index_Type, Unsigned_64 (Nbr_Assocs));
            end if;

            Start_Loop_Stmt (Label);
            New_Assign_Stmt
              (New_Obj (Var_Mid),
               New_Dyadic_Op (ON_Div_Ov,
                              New_Dyadic_Op (ON_Add_Ov,
                                             New_Obj_Value (Var_Lo),
                                             New_Obj_Value (Var_Hi)),
                              New_Lit (New_Unsigned_Literal
                                         (Ghdl_Index_Type, 2))));
            New_Assign_Stmt
              (New_Obj (Var_Cmp),
               Translate_Simple_String_Choice
                 (Expr_Node,
                  New_Address (New_Indexed_Element (New_Obj (Table),
                                                    New_Obj_Value (Var_Mid)),
                               Tinfo.T.Base_Ptr_Type (Mode_Value)),
                  C_Node, Tinfo, Func));
            Start_If_Stmt
              (If_Blk1,
               New_Compare_Op (ON_Eq,
                               New_Obj_Value (Var_Cmp),
                               New_Lit (Ghdl_Compare_Eq),
                               Ghdl_Bool_Type));
            New_Assign_Stmt
              (New_Obj (Var_Idx),
               New_Value (New_Indexed_Element (New_Obj (Assoc_Table),
                                               New_Obj_Value (Var_Mid))));
            New_Exit_Stmt (Label);
            Finish_If_Stmt (If_Blk1);

            Start_If_Stmt
              (If_Blk1,
               New_Compare_Op (ON_Eq,
                               New_Obj_Value (Var_Cmp),
                               New_Lit (Ghdl_Compare_Lt),
                               Ghdl_Bool_Type));
            Start_If_Stmt
              (If_Blk2,
               New_Compare_Op (ON_Le,
                               New_Obj_Value (Var_Mid),
                               New_Obj_Value (Var_Lo),
                               Ghdl_Bool_Type));
            if not Has_Others then
               Chap6.Gen_Program_Error (Stmt, Chap6.Prg_Err_Bad_Choice);
            else
               New_Assign_Stmt (New_Obj (Var_Idx), New_Lit (Others_Lit));
               New_Exit_Stmt (Label);
            end if;
            New_Else_Stmt (If_Blk2);
            New_Assign_Stmt (New_Obj (Var_Hi),
                             New_Dyadic_Op (ON_Sub_Ov,
                                            New_Obj_Value (Var_Mid),
                                            New_Lit (Ghdl_Index_1)));
            Finish_If_Stmt (If_Blk2);

            New_Else_Stmt (If_Blk1);

            Start_If_Stmt
              (If_Blk2,
               New_Compare_Op (ON_Ge,
                               New_Obj_Value (Var_Mid),
                               New_Obj_Value (Var_Hi),
                               Ghdl_Bool_Type));
            if not Has_Others then
               Chap6.Gen_Program_Error (Stmt, Chap6.Prg_Err_No_Choice);
            else
               New_Assign_Stmt (New_Obj (Var_Idx), New_Lit (Others_Lit));
               New_Exit_Stmt (Label);
            end if;
            New_Else_Stmt (If_Blk2);
            New_Assign_Stmt (New_Obj (Var_Lo),
                             New_Dyadic_Op (ON_Add_Ov,
                                            New_Obj_Value (Var_Mid),
                                            New_Lit (Ghdl_Index_1)));
            Finish_If_Stmt (If_Blk2);

            Finish_If_Stmt (If_Blk1);

            Finish_Loop_Stmt (Label);

            Finish_Declare_Stmt;

            Start_Case_Stmt (Case_Blk, New_Obj_Value (Var_Idx));

            Choice := Choices_Chain;
            while Choice /= Null_Iir loop
               case Get_Kind (Choice) is
                  when Iir_Kind_Choice_By_Others =>
                     Start_Choice (Case_Blk);
                     New_Expr_Choice (Case_Blk, Others_Lit);
                     Finish_Choice (Case_Blk);
                     Translate_Statements_Chain (Get_Associated (Choice));
                  when Iir_Kind_Choice_By_Expression =>
                     if not Get_Same_Alternative_Flag (Choice) then
                        Start_Choice (Case_Blk);
                        New_Expr_Choice
                          (Case_Blk,
                           New_Unsigned_Literal
                             (Ghdl_Index_Type,
                              Unsigned_64 (Get_Info (Choice).Choice_Assoc)));
                        Finish_Choice (Case_Blk);
                        Translate_Statements_Chain (Get_Associated (Choice));
                     end if;
                     Free_Info (Choice);
                  when others =>
                     raise Internal_Error;
               end case;
               Choice := Get_Chain (Choice);
            end loop;

            Start_Choice (Case_Blk);
            New_Default_Choice (Case_Blk);
            Finish_Choice (Case_Blk);
            Chap6.Gen_Program_Error (Stmt, Chap6.Prg_Err_No_Choice);

            Finish_Case_Stmt (Case_Blk);
         end;
      end Translate_String_Case_Statement_Dichotomy;

      --  Case statement whose expression is an unidim array.
      --  Translate into if/elsif statements (linear search).
      procedure Translate_String_Case_Statement_Linear
        (Stmt : Iir_Case_Statement)
      is
         Expr_Type : Iir;
         --  Node containing the address of the selector.
         Expr_Node : O_Dnode;
         --  Node containing the current choice.
         Val_Node : O_Dnode;
         Tinfo : Type_Info_Acc;

         Cond_Var : O_Dnode;

         Func : Iir;

         procedure Translate_String_Choice (Choice : Iir)
         is
            Cond : O_Enode;
            If_Blk : O_If_Block;
            Stmt_Chain : Iir;
            First : Boolean;
            Ch : Iir;
            Ch_Expr : Iir;
         begin
            if Choice = Null_Iir then
               return;
            end if;

            First := True;
            Stmt_Chain := Get_Associated (Choice);
            Ch := Choice;
            loop
               case Get_Kind (Ch) is
                  when Iir_Kind_Choice_By_Expression =>
                     Ch_Expr := Get_Expression (Ch);
                     Cond := Translate_Simple_String_Choice
                       (Expr_Node,
                        Chap7.Translate_Expression (Ch_Expr,
                                                    Get_Type (Ch_Expr)),
                        Val_Node, Tinfo, Func);
                  when Iir_Kind_Choice_By_Others =>
                     Translate_Statements_Chain (Stmt_Chain);
                     return;
                  when others =>
                     Error_Kind ("translate_string_choice", Ch);
               end case;
               if not First then
                  New_Assign_Stmt
                    (New_Obj (Cond_Var),
                     New_Dyadic_Op (ON_Or, New_Obj_Value (Cond_Var), Cond));
               end if;
               Ch := Get_Chain (Ch);
               exit when Ch = Null_Iir;
               exit when not Get_Same_Alternative_Flag (Ch);
               exit when Get_Associated (Ch) /= Null_Iir;
               if First then
                  New_Assign_Stmt (New_Obj (Cond_Var), Cond);
                  First := False;
               end if;
            end loop;
            if not First then
               Cond := New_Obj_Value (Cond_Var);
            end if;
            Start_If_Stmt (If_Blk, Cond);
            Translate_Statements_Chain (Stmt_Chain);
            New_Else_Stmt (If_Blk);
            Translate_String_Choice (Ch);
            Finish_If_Stmt (If_Blk);
         end Translate_String_Choice;
      begin
         Translate_String_Case_Statement_Common
           (Stmt, Expr_Type, Tinfo, Expr_Node, Val_Node);

         Func := Chap7.Find_Predefined_Function
           (Get_Base_Type (Expr_Type), Iir_Predefined_Array_Equality);

         Cond_Var := Create_Temp (Std_Boolean_Type_Node);

         Translate_String_Choice (Get_Case_Statement_Alternative_Chain (Stmt));
      end Translate_String_Case_Statement_Linear;

      procedure Translate_Case_Choice
        (Choice : Iir; Choice_Type : Iir; Blk : in out O_Case_Block)
      is
         Expr : Iir;
      begin
         case Get_Kind (Choice) is
            when Iir_Kind_Choice_By_Others =>
               New_Default_Choice (Blk);
            when Iir_Kind_Choice_By_Expression =>
               Expr := Get_Expression (Choice);
               New_Expr_Choice
                 (Blk, Chap7.Translate_Static_Expression (Expr, Choice_Type));
            when Iir_Kind_Choice_By_Range =>
               declare
                  H, L : Iir;
               begin
                  Expr := Get_Expression (Choice);
                  Get_Low_High_Limit (Expr, L, H);
                  New_Range_Choice
                    (Blk,
                     Chap7.Translate_Static_Expression (L, Choice_Type),
                     Chap7.Translate_Static_Expression (H, Choice_Type));
               end;
            when others =>
               Error_Kind ("translate_case_choice", Choice);
         end case;
      end Translate_Case_Choice;

      procedure Translate_Case_Statement (Stmt : Iir_Case_Statement)
      is
         Expr : Iir;
         Expr_Type : Iir;
         Case_Blk : O_Case_Block;
         Choice : Iir;
         Stmt_Chain : Iir;
      begin
         Expr := Get_Expression (Stmt);
         Expr_Type := Get_Type (Expr);
         if Get_Kind (Expr_Type) = Iir_Kind_Array_Subtype_Definition then
            declare
               Nbr_Choices : Natural := 0;
               Choice : Iir;
            begin
               Choice := Get_Case_Statement_Alternative_Chain (Stmt);
               while Choice /= Null_Iir loop
                  case Get_Kind (Choice) is
                     when Iir_Kind_Choice_By_Others =>
                        exit;
                     when Iir_Kind_Choice_By_Expression =>
                        null;
                     when others =>
                        raise Internal_Error;
                  end case;
                  Nbr_Choices := Nbr_Choices + 1;
                  Choice := Get_Chain (Choice);
               end loop;

               if Nbr_Choices < 3 then
                  Translate_String_Case_Statement_Linear (Stmt);
               else
                  Translate_String_Case_Statement_Dichotomy (Stmt);
               end if;
            end;
            return;
         end if;
         Start_Case_Stmt (Case_Blk, Chap7.Translate_Expression (Expr));
         Choice := Get_Case_Statement_Alternative_Chain (Stmt);
         while Choice /= Null_Iir loop
            Start_Choice (Case_Blk);
            Stmt_Chain := Get_Associated (Choice);
            loop
               Translate_Case_Choice (Choice, Expr_Type, Case_Blk);
               Choice := Get_Chain (Choice);
               exit when Choice = Null_Iir;
               exit when not Get_Same_Alternative_Flag (Choice);
               if Get_Associated (Choice) /= Null_Iir then
                  raise Internal_Error;
               end if;
            end loop;
            Finish_Choice (Case_Blk);
            Translate_Statements_Chain (Stmt_Chain);
         end loop;
         Finish_Case_Stmt (Case_Blk);
      end Translate_Case_Statement;

      procedure Translate_Write_Procedure_Call (Imp : Iir; Param_Chain : Iir)
      is
         F_Assoc : Iir;
         Value_Assoc : Iir;
         Value : O_Dnode;
         Formal_Type : Iir;
         Tinfo : Type_Info_Acc;
         Assocs : O_Assoc_List;
         Subprg_Info : Subprg_Info_Acc;
      begin
         F_Assoc := Param_Chain;
         Value_Assoc := Get_Chain (Param_Chain);
         Formal_Type := Get_Type (Get_Formal (Value_Assoc));
         Tinfo := Get_Info (Formal_Type);
         case Tinfo.Type_Mode is
            when Type_Mode_Scalar =>
               Open_Temp;
               Start_Association (Assocs, Ghdl_Write_Scalar);
               --    compute file parameter (get an index)
               New_Association
                 (Assocs, Chap7.Translate_Expression (Get_Actual (F_Assoc)));
               --    compute the value.
               Value := Create_Temp (Tinfo.Ortho_Type (Mode_Value));
               New_Assign_Stmt
                 (New_Obj (Value),
                  Chap7.Translate_Expression (Get_Actual (Value_Assoc),
                                              Formal_Type));
               New_Association
                 (Assocs,
                  New_Unchecked_Address (New_Obj (Value), Ghdl_Ptr_Type));
               --    length.
               New_Association
                 (Assocs, New_Lit (New_Sizeof (Tinfo.Ortho_Type (Mode_Value),
                                               Ghdl_Index_Type)));
               --    call a predefined procedure
               New_Procedure_Call (Assocs);
               Close_Temp;
            when Type_Mode_Array
              | Type_Mode_Record
              | Type_Mode_Fat_Array =>
               Subprg_Info := Get_Info (Imp);
               Start_Association (Assocs, Subprg_Info.Ortho_Func);
               Chap2.Add_Subprg_Instance_Assoc
                 (Assocs, Subprg_Info.Subprg_Instance);
               New_Association
                 (Assocs, Chap7.Translate_Expression (Get_Actual (F_Assoc)));
               New_Association
                 (Assocs,
                  Chap7.Translate_Expression (Get_Actual (Value_Assoc),
                                              Formal_Type));
               New_Procedure_Call (Assocs);
            when Type_Mode_Unknown
              | Type_Mode_File
              | Type_Mode_Acc
              | Type_Mode_Fat_Acc
              | Type_Mode_Protected =>
               raise Internal_Error;
         end case;
      end Translate_Write_Procedure_Call;

      procedure Translate_Read_Procedure_Call (Imp : Iir; Param_Chain : Iir)
      is
         F_Assoc : Iir;
         Value_Assoc : Iir;
         Value : Mnode;
         Formal_Type : Iir;
         Tinfo : Type_Info_Acc;
         Assocs : O_Assoc_List;
         Subprg_Info : Subprg_Info_Acc;
      begin
         F_Assoc := Param_Chain;
         Value_Assoc := Get_Chain (Param_Chain);
         Formal_Type := Get_Type (Get_Formal (Value_Assoc));
         Tinfo := Get_Info (Formal_Type);
         case Tinfo.Type_Mode is
            when Type_Mode_Scalar =>
               Open_Temp;
               Start_Association (Assocs, Ghdl_Read_Scalar);
               --    compute file parameter (get an index)
               New_Association
                 (Assocs, Chap7.Translate_Expression (Get_Actual (F_Assoc)));
               --  value
               Value := Chap6.Translate_Name (Get_Actual (Value_Assoc));
               New_Association
                 (Assocs, New_Convert_Ov (M2Addr (Value), Ghdl_Ptr_Type));
               --    length.
               New_Association
                 (Assocs, New_Lit (New_Sizeof (Tinfo.Ortho_Type (Mode_Value),
                                               Ghdl_Index_Type)));
               --    call a predefined procedure
               New_Procedure_Call (Assocs);
               Close_Temp;
            when Type_Mode_Array
              | Type_Mode_Record =>
               Subprg_Info := Get_Info (Imp);
               Start_Association (Assocs, Subprg_Info.Ortho_Func);
               Chap2.Add_Subprg_Instance_Assoc
                 (Assocs, Subprg_Info.Subprg_Instance);
               New_Association
                 (Assocs, Chap7.Translate_Expression (Get_Actual (F_Assoc)));
               New_Association
                 (Assocs,
                  Chap7.Translate_Expression (Get_Actual (Value_Assoc)));
               New_Procedure_Call (Assocs);
            when Type_Mode_Fat_Array =>
               declare
                  Length_Assoc : Iir;
                  Length : Mnode;
               begin
                  Length_Assoc := Get_Chain (Value_Assoc);
                  Subprg_Info := Get_Info (Imp);
                  Start_Association (Assocs, Subprg_Info.Ortho_Func);
                  Chap2.Add_Subprg_Instance_Assoc
                    (Assocs, Subprg_Info.Subprg_Instance);
                  New_Association
                    (Assocs,
                     Chap7.Translate_Expression (Get_Actual (F_Assoc)));
                  New_Association
                    (Assocs,
                     Chap7.Translate_Expression (Get_Actual (Value_Assoc),
                                                 Formal_Type));
                  Length := Chap6.Translate_Name (Get_Actual (Length_Assoc));
                  New_Assign_Stmt (M2Lv (Length), New_Function_Call (Assocs));
               end;
            when Type_Mode_Unknown
              | Type_Mode_File
              | Type_Mode_Acc
              | Type_Mode_Fat_Acc
              | Type_Mode_Protected =>
               raise Internal_Error;
         end case;
      end Translate_Read_Procedure_Call;

      procedure Translate_Implicit_Procedure_Call (Call : Iir_Procedure_Call)
      is
         Imp : constant Iir := Get_Named_Entity (Get_Implementation (Call));
         Kind : constant Iir_Predefined_Functions :=
           Get_Implicit_Definition (Imp);
         Param_Chain : constant Iir := Get_Parameter_Association_Chain (Call);
      begin
         case Kind is
            when Iir_Predefined_Write =>
               --  Check wether text or not.
               declare
                  File_Param : Iir;
                  Assocs : O_Assoc_List;
               begin
                  File_Param := Param_Chain;
                  -- FIXME: do the test.
                  if Get_Text_File_Flag (Get_Type (Get_Formal (File_Param)))
                  then
                     --  If text:
                     Start_Association (Assocs, Ghdl_Text_Write);
                     --    compute file parameter (get an index)
                     New_Association
                       (Assocs,
                        Chap7.Translate_Expression (Get_Actual (File_Param)));
                     --    compute string parameter (get a fat array pointer)
                     New_Association
                       (Assocs, Chap7.Translate_Expression
                        (Get_Actual (Get_Chain (Param_Chain)),
                         String_Type_Definition));
                     --    call a predefined procedure
                     New_Procedure_Call (Assocs);
                  else
                     Translate_Write_Procedure_Call (Imp, Param_Chain);
                  end if;
               end;

            when Iir_Predefined_Read_Length =>
               --  FIXME: works only for text read length.
               declare
                  File_Param : Iir;
                  N_Param : Iir;
                  Assocs : O_Assoc_List;
                  Str : O_Enode;
                  Res : Mnode;
               begin
                  File_Param := Param_Chain;
                  if Get_Text_File_Flag (Get_Type (Get_Formal (File_Param)))
                  then
                     N_Param := Get_Chain (File_Param);
                     Str := Chap7.Translate_Expression
                       (Get_Actual (N_Param), String_Type_Definition);
                     N_Param := Get_Chain (N_Param);
                     Res := Chap6.Translate_Name (Get_Actual (N_Param));
                     Start_Association (Assocs, Ghdl_Text_Read_Length);
                     --    compute file parameter (get an index)
                     New_Association
                       (Assocs,
                        Chap7.Translate_Expression (Get_Actual (File_Param)));
                     --    compute string parameter (get a fat array pointer)
                     New_Association (Assocs, Str);
                     --    call a predefined procedure
                     New_Assign_Stmt
                       (M2Lv (Res), New_Function_Call (Assocs));
                  else
                     Translate_Read_Procedure_Call (Imp, Param_Chain);
                  end if;
               end;

            when Iir_Predefined_Read =>
               Translate_Read_Procedure_Call (Imp, Param_Chain);

            when Iir_Predefined_Deallocate =>
               Chap3.Translate_Object_Deallocation (Get_Actual (Param_Chain));

            when Iir_Predefined_File_Open =>
               declare
                  N_Param : Iir;
                  File_Param : Iir;
                  Name_Param : Iir;
                  Kind_Param : Iir;
                  Constr : O_Assoc_List;
               begin
                  File_Param := Get_Actual (Param_Chain);
                  N_Param := Get_Chain (Param_Chain);
                  Name_Param := Get_Actual (N_Param);
                  N_Param := Get_Chain (N_Param);
                  Kind_Param := Get_Actual (N_Param);
                  if Get_Text_File_Flag (Get_Type (File_Param)) then
                     Start_Association (Constr, Ghdl_Text_File_Open);
                  else
                     Start_Association (Constr, Ghdl_File_Open);
                  end if;
                  New_Association
                    (Constr, Chap7.Translate_Expression (File_Param));
                  New_Association
                    (Constr, New_Convert_Ov
                     (Chap7.Translate_Expression (Kind_Param), Ghdl_I32_Type));
                  New_Association
                    (Constr,
                     Chap7.Translate_Expression (Name_Param,
                                                 String_Type_Definition));
                  New_Procedure_Call (Constr);
               end;

            when Iir_Predefined_File_Open_Status =>
               declare
                  N_Param : Iir;
                  Status_Param : Iir;
                  File_Param : Iir;
                  Name_Param : Iir;
                  Kind_Param : Iir;
                  Constr : O_Assoc_List;
                  Status : Mnode;
               begin
                  Status_Param := Get_Actual (Param_Chain);
                  Status := Chap6.Translate_Name (Status_Param);
                  N_Param := Get_Chain (Param_Chain);
                  File_Param := Get_Actual (N_Param);
                  N_Param := Get_Chain (N_Param);
                  Name_Param := Get_Actual (N_Param);
                  N_Param := Get_Chain (N_Param);
                  Kind_Param := Get_Actual (N_Param);
                  if Get_Text_File_Flag (Get_Type (File_Param)) then
                     Start_Association (Constr, Ghdl_Text_File_Open_Status);
                  else
                     Start_Association (Constr, Ghdl_File_Open_Status);
                  end if;
                  New_Association
                    (Constr, Chap7.Translate_Expression (File_Param));
                  New_Association
                    (Constr, New_Convert_Ov
                     (Chap7.Translate_Expression (Kind_Param), Ghdl_I32_Type));
                  New_Association
                    (Constr,
                     Chap7.Translate_Expression (Name_Param,
                                                 String_Type_Definition));
                  New_Assign_Stmt
                    (M2Lv (Status),
                     New_Convert_Ov (New_Function_Call (Constr),
                                     Std_File_Open_Status_Type));
               end;

            when Iir_Predefined_File_Close =>
               declare
                  File_Param : Iir;
                  Constr : O_Assoc_List;
               begin
                  File_Param := Get_Actual (Param_Chain);
                  if Get_Text_File_Flag (Get_Type (File_Param)) then
                     Start_Association (Constr, Ghdl_Text_File_Close);
                  else
                     Start_Association (Constr, Ghdl_File_Close);
                  end if;
                  New_Association
                    (Constr, Chap7.Translate_Expression (File_Param));
                  New_Procedure_Call (Constr);
               end;

            when others =>
               Ada.Text_IO.Put_Line
                 ("translate_implicit_procedure_call: cannot handle "
                  & Iir_Predefined_Functions'Image (Kind));
               raise Internal_Error;
         end case;
      end Translate_Implicit_Procedure_Call;

      function Do_Conversion (Conv : Iir; Expr : Iir; Src : Mnode)
        return O_Enode
      is
         Constr : O_Assoc_List;
         Conv_Info : Subprg_Info_Acc;
         Res : O_Dnode;
         Imp : Iir;
      begin
         if Conv = Null_Iir then
            return M2E (Src);
--             case Get_Type_Info (Dest).Type_Mode is
--                when Type_Mode_Thin =>
--                   New_Assign_Stmt (M2Lv (Dest), M2E (Src));
--                when Type_Mode_Fat_Acc =>
--                   Copy_Fat_Pointer (Stabilize (Dest), Stabilize (Src));
--                when others =>
--                   raise Internal_Error;
--             end case;
         else
            case Get_Kind (Conv) is
               when Iir_Kind_Function_Call =>
                  --  Call conversion function.
                  Imp := Get_Named_Entity (Get_Implementation (Conv));
                  Conv_Info := Get_Info (Imp);
                  Start_Association (Constr, Conv_Info.Ortho_Func);

                  if Conv_Info.Res_Interface /= O_Dnode_Null then
                     Res := Create_Temp (Conv_Info.Res_Record_Type);
                     --  Composite result.
                     New_Association
                       (Constr,
                        New_Address (New_Obj (Res), Conv_Info.Res_Record_Ptr));
                  end if;

                  Chap2.Add_Subprg_Instance_Assoc
                    (Constr, Conv_Info.Subprg_Instance);

                  New_Association (Constr, M2E (Src));

                  if Conv_Info.Res_Interface /= O_Dnode_Null then
                     --  Composite result.
                     New_Procedure_Call (Constr);
                     return New_Address (New_Obj (Res),
                                         Conv_Info.Res_Record_Ptr);
                  else
                     return New_Function_Call (Constr);
                  end if;
               when Iir_Kind_Type_Conversion =>
                  return Chap7.Translate_Type_Conversion
                    (M2E (Src), Get_Type (Expr),
                     Get_Type (Conv), Null_Iir);
               when others =>
                  Error_Kind ("do_conversion", Conv);
            end case;
         end if;
      end Do_Conversion;

      procedure Translate_Procedure_Call (Stmt : Iir_Procedure_Call)
      is
         type Mnode_Array is array (Natural range <>) of Mnode;
         type O_Enode_Array is array (Natural range <>) of O_Enode;
         Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt);
         Nbr_Assoc : constant Natural :=
           Iir_Chains.Get_Chain_Length (Assoc_Chain);
         Params : Mnode_Array (0 .. Nbr_Assoc - 1);
         E_Params : O_Enode_Array (0 .. Nbr_Assoc - 1);
         Imp : constant Iir := Get_Named_Entity (Get_Implementation (Stmt));
         Info : constant Subprg_Info_Acc := Get_Info (Imp);
         Res : O_Dnode;
         El : Iir;
         Pos : Natural;
         Constr : O_Assoc_List;
         Act : Iir;
         Actual_Type : Iir;
         Formal : Iir;
         Base_Formal : Iir;
         Formal_Type : Iir;
         Ftype_Info : Type_Info_Acc;
         Formal_Info : Ortho_Info_Acc;
         Val : O_Enode;
         Param : Mnode;
         Last_Individual : Natural;
         Ptr : O_Lnode;
         In_Conv : Iir;
         In_Expr : Iir;
         Out_Conv : Iir;
         Out_Expr : Iir;
         Formal_Object_Kind : Object_Kind_Type;
         Bounds : O_Enode;
         Obj : Iir;
      begin
         --  Create an in-out result record for in-out arguments passed by
         --  value.
         if Info.Res_Record_Type /= O_Tnode_Null then
            Res := Create_Temp (Info.Res_Record_Type);
         else
            Res := O_Dnode_Null;
         end if;

         --  Evaluate in-out parameters and parameters passed by ref, since
         --  they can add declarations.
         --  Non-composite in-out parameters address are saved in order to
         --  be able to assignate the result.
         El := Assoc_Chain;
         Pos := 0;
         while El /= Null_Iir loop
            Params (Pos) := Mnode_Null;
            E_Params (Pos) := O_Enode_Null;

            Formal := Get_Formal (El);
            if Get_Kind (Formal) in Iir_Kinds_Denoting_Name then
               Formal := Get_Named_Entity (Formal);
            end if;
            Base_Formal := Get_Association_Interface (El);
            Formal_Type := Get_Type (Formal);
            Formal_Info := Get_Info (Base_Formal);
            if Get_Kind (Base_Formal) = Iir_Kind_Signal_Interface_Declaration
            then
               Formal_Object_Kind := Mode_Signal;
            else
               Formal_Object_Kind := Mode_Value;
            end if;
            Ftype_Info := Get_Info (Formal_Type);

            case Get_Kind (El) is
               when Iir_Kind_Association_Element_Open =>
                  Act := Get_Default_Value (Formal);
                  In_Conv := Null_Iir;
                  Out_Conv := Null_Iir;
               when Iir_Kind_Association_Element_By_Expression =>
                  Act := Get_Actual (El);
                  In_Conv := Get_In_Conversion (El);
                  Out_Conv := Get_Out_Conversion (El);
               when Iir_Kind_Association_Element_By_Individual =>
                  Actual_Type := Get_Actual_Type (El);
                  if Formal_Info.Interface_Field /= O_Fnode_Null then
                     --  A non-composite type cannot be associated by element.
                     raise Internal_Error;
                  end if;
                  if Ftype_Info.Type_Mode = Type_Mode_Fat_Array then
                     Chap3.Create_Array_Subtype (Actual_Type, True);
                     Bounds := M2E (Chap3.Get_Array_Type_Bounds (Actual_Type));
                     Param := Create_Temp (Ftype_Info, Formal_Object_Kind);
                     Chap3.Translate_Object_Allocation
                       (Param, Alloc_Stack, Formal_Type, Bounds);
                  else
                     Param := Create_Temp (Ftype_Info, Formal_Object_Kind);
                     Chap4.Allocate_Complex_Object
                       (Formal_Type, Alloc_Stack, Param);
                  end if;
                  Last_Individual := Pos;
                  Params (Pos) := Param;
                  goto Continue;
               when others =>
                  Error_Kind ("translate_procedure_call", El);
            end case;
            Actual_Type := Get_Type (Act);

            if Formal_Info.Interface_Field /= O_Fnode_Null then
               --  Copy-out argument.
               --  This is not a composite type.
               Param := Chap6.Translate_Name (Act);
               if Get_Object_Kind (Param) /= Mode_Value then
                  raise Internal_Error;
               end if;
               Params (Pos) := Stabilize (Param);
               if In_Conv /= Null_Iir
                 or else Get_Mode (Formal) = Iir_Inout_Mode
               then
                  --  Arguments may be assigned if there is an in conversion.
                  Ptr := New_Selected_Element
                    (New_Obj (Res), Formal_Info.Interface_Field);
                  Param := Lv2M (Ptr, Ftype_Info, Mode_Value);
                  if In_Conv /= Null_Iir then
                     In_Expr := In_Conv;
                  else
                     In_Expr := Act;
                  end if;
                  Chap7.Translate_Assign
                    (Param,
                     Do_Conversion (In_Conv, Act, Params (Pos)),
                     In_Expr,
                     Formal_Type, El);
               end if;
            elsif Ftype_Info.Type_Mode not in Type_Mode_By_Value then
               --  Passed by reference.
               case Get_Kind (Base_Formal) is
                  when Iir_Kind_Constant_Interface_Declaration
                    | Iir_Kind_File_Interface_Declaration =>
                     --  No conversion here.
                     E_Params (Pos) := Chap7.Translate_Expression
                       (Act, Formal_Type);
                  when Iir_Kind_Variable_Interface_Declaration
                    | Iir_Kind_Signal_Interface_Declaration =>
                     Param := Chap6.Translate_Name (Act);
                     --  Atype may not have been set (eg: slice).
                     if Base_Formal /= Formal then
                        Stabilize (Param);
                        Params (Pos) := Param;
                     end if;
                     E_Params (Pos) := M2E (Param);
                     if Formal_Type /= Actual_Type then
                        --  Implicit array conversion or subtype check.
                        E_Params (Pos) := Chap7.Translate_Implicit_Conv
                          (E_Params (Pos), Actual_Type, Formal_Type,
                           Get_Object_Kind (Param), Stmt);
                     end if;
                  when others =>
                     Error_Kind ("translate_procedure_call(2)", Formal);
               end case;
            end if;
            if Base_Formal /= Formal then
               --  Individual association.
               if Ftype_Info.Type_Mode not in Type_Mode_By_Value then
                  --  Not by-value actual already translated.
                  Val := E_Params (Pos);
               else
                  --  By value association.
                  Act := Get_Actual (El);
                  if Get_Kind (Base_Formal)
                    = Iir_Kind_Constant_Interface_Declaration
                  then
                     Val := Chap7.Translate_Expression (Act, Formal_Type);
                  else
                     Params (Pos) := Chap6.Translate_Name (Act);
                     --  Since signals are passed by reference, they are not
                     --  copied back, so do not stabilize them (furthermore,
                     --  it is not possible to stabilize them).
                     if Formal_Object_Kind = Mode_Value then
                        Params (Pos) := Stabilize (Params (Pos));
                     end if;
                     Val := M2E (Params (Pos));
                  end if;
               end if;
               --  Assign formal.
               --  Change the formal variable so that it is the local variable
               --  that will be passed to the subprogram.
               declare
                  Prev_Node : O_Dnode;
               begin
                  Prev_Node := Formal_Info.Interface_Node;
                  --  We need a pointer since the interface is by reference.
                  Formal_Info.Interface_Node :=
                    M2Dp (Params (Last_Individual));
                  Param := Chap6.Translate_Name (Formal);
                  Formal_Info.Interface_Node := Prev_Node;
               end;
               Chap7.Translate_Assign (Param, Val, Act, Formal_Type, El);
            end if;
            << Continue >> null;
            El := Get_Chain (El);
            Pos := Pos + 1;
         end loop;

         --  Second stage:  really perform the call.
         Start_Association (Constr, Info.Ortho_Func);
         if Res /= O_Dnode_Null then
            New_Association (Constr,
                             New_Address (New_Obj (Res), Info.Res_Record_Ptr));
         end if;

         Obj := Get_Method_Object (Stmt);
         if Obj /= Null_Iir then
            New_Association (Constr, M2E (Chap6.Translate_Name (Obj)));
         else
            Chap2.Add_Subprg_Instance_Assoc (Constr, Info.Subprg_Instance);
         end if;

         --  Parameters.
         El := Assoc_Chain;
         Pos := 0;
         while El /= Null_Iir loop
            Formal := Get_Formal (El);
            if Get_Kind (Formal) in Iir_Kinds_Denoting_Name then
               Formal := Get_Named_Entity (Formal);
            end if;
            Base_Formal := Get_Association_Interface (El);
            Formal_Info := Get_Info (Base_Formal);
            Formal_Type := Get_Type (Formal);
            Ftype_Info := Get_Info (Formal_Type);

            if Get_Kind (El) = Iir_Kind_Association_Element_By_Individual then
               Last_Individual := Pos;
               New_Association (Constr, M2E (Params (Pos)));
            elsif Base_Formal /= Formal then
               --  Individual association.
               null;
            elsif Formal_Info.Interface_Field = O_Fnode_Null then
               if Ftype_Info.Type_Mode in Type_Mode_By_Value then
                  --  Parameter passed by value.
                  if E_Params (Pos) /= O_Enode_Null then
                     Val := E_Params (Pos);
                     raise Internal_Error;
                  else
                     case Get_Kind (El) is
                        when Iir_Kind_Association_Element_Open =>
                           Act := Get_Default_Value (Formal);
                           In_Conv := Null_Iir;
                        when Iir_Kind_Association_Element_By_Expression =>
                           Act := Get_Actual (El);
                           In_Conv := Get_In_Conversion (El);
                        when others =>
                           Error_Kind ("translate_procedure_call(2)", El);
                     end case;
                     case Get_Kind (Formal) is
                        when Iir_Kind_Signal_Interface_Declaration =>
                           Param := Chap6.Translate_Name (Act);
                           --  This is a scalar.
                           Val := M2E (Param);
                        when others =>
                           if In_Conv = Null_Iir then
                              Val := Chap7.Translate_Expression
                                (Act, Formal_Type);
                           else
                              Actual_Type := Get_Type (Act);
                              Val := Do_Conversion
                                (In_Conv,
                                 Act,
                                 E2M (Chap7.Translate_Expression (Act,
                                                                  Actual_Type),
                                      Get_Info (Actual_Type),
                                      Mode_Value));
                           end if;
                     end case;
                  end if;
                  New_Association (Constr, Val);
               else
                  --  Parameter passed by ref, which was already computed.
                  New_Association (Constr, E_Params (Pos));
               end if;
            end if;
            El := Get_Chain (El);
            Pos := Pos + 1;
         end loop;

         New_Procedure_Call (Constr);

         --  Copy-out non-composite parameters.
         El := Assoc_Chain;
         Pos := 0;
         while El /= Null_Iir loop
            Formal := Get_Formal (El);
            Base_Formal := Get_Association_Interface (El);
            Formal_Type := Get_Type (Formal);
            Ftype_Info := Get_Info (Formal_Type);
            Formal_Info := Get_Info (Base_Formal);
            if Get_Kind (Base_Formal) = Iir_Kind_Variable_Interface_Declaration
              and then Get_Mode (Base_Formal) in Iir_Out_Modes
              and then Params (Pos) /= Mnode_Null
            then
               if Formal_Info.Interface_Field /= O_Fnode_Null then
                  --  OUT parameters.
                  Out_Conv := Get_Out_Conversion (El);
                  if Out_Conv = Null_Iir then
                     Out_Expr := Formal;
                  else
                     Out_Expr := Out_Conv;
                  end if;
                  Ptr := New_Selected_Element
                    (New_Obj (Res), Formal_Info.Interface_Field);
                  Param := Lv2M (Ptr, Ftype_Info, Mode_Value);
                  Chap7.Translate_Assign (Params (Pos),
                                          Do_Conversion (Out_Conv, Formal,
                                                         Param),
                                          Out_Expr,
                                          Get_Type (Get_Actual (El)), El);
               elsif Base_Formal /= Formal then
                  --  By individual.
                  --  Copy back.
                  Act := Get_Actual (El);
                  declare
                     Prev_Node : O_Dnode;
                  begin
                     Prev_Node := Formal_Info.Interface_Node;
                     --  We need a pointer since the interface is by reference.
                     Formal_Info.Interface_Node :=
                       M2Dp (Params (Last_Individual));
                     Val := Chap7.Translate_Expression
                       (Formal, Get_Type (Act));
                     Formal_Info.Interface_Node := Prev_Node;
                  end;
                  Chap7.Translate_Assign
                    (Params (Pos), Val, Formal, Get_Type (Act), El);
               end if;
            end if;
            El := Get_Chain (El);
            Pos := Pos + 1;
         end loop;
      end Translate_Procedure_Call;

      procedure Translate_Wait_Statement (Stmt : Iir)
      is
         Sensitivity : Iir_List;
         Cond : Iir;
         Timeout : Iir;
         Constr : O_Assoc_List;
      begin
         Sensitivity := Get_Sensitivity_List (Stmt);
         Cond := Get_Condition_Clause (Stmt);
         Timeout := Get_Timeout_Clause (Stmt);

         if Sensitivity = Null_Iir_List and Cond /= Null_Iir then
            Sensitivity := Create_Iir_List;
            Canon.Canon_Extract_Sensitivity (Cond, Sensitivity);
            Set_Sensitivity_List (Stmt, Sensitivity);
         end if;

         --  Check for simple cases.
         if Sensitivity = Null_Iir_List
           and then Cond = Null_Iir
         then
            if Timeout = Null_Iir then
               --  Process exit.
               Start_Association (Constr, Ghdl_Process_Wait_Exit);
               New_Procedure_Call (Constr);
            else
               --  Wait for a timeout.
               Start_Association (Constr, Ghdl_Process_Wait_Timeout);
               New_Association (Constr, Chap7.Translate_Expression
                                (Timeout, Time_Type_Definition));
               New_Procedure_Call (Constr);
            end if;
            return;
         end if;

         --  Evaluate the timeout (if any) and register it,
         if Timeout /= Null_Iir then
            Start_Association (Constr, Ghdl_Process_Wait_Set_Timeout);
            New_Association (Constr, Chap7.Translate_Expression
                             (Timeout, Time_Type_Definition));
            New_Procedure_Call (Constr);
         end if;

         --  Evaluate the sensitivity list and register it.
         if Sensitivity /= Null_Iir_List then
            Register_Signal_List
              (Sensitivity, Ghdl_Process_Wait_Add_Sensitivity);
         end if;

         if Cond = Null_Iir then
            declare
               V : O_Dnode;
            begin
               --  declare
               --     v : __ghdl_bool_type_node;
               --  begin
               --     v := suspend ();
               --  end;
               Open_Temp;
               V := Create_Temp (Ghdl_Bool_Type);
               Start_Association (Constr, Ghdl_Process_Wait_Suspend);
               New_Assign_Stmt (New_Obj (V), New_Function_Call (Constr));
               Close_Temp;
            end;
         else
            declare
               Label : O_Snode;
            begin
               --  start loop
               Start_Loop_Stmt (Label);

               --    if suspend() then        --  return true if timeout.
               --      exit;
               --    end if;
               Start_Association (Constr, Ghdl_Process_Wait_Suspend);
               Gen_Exit_When (Label, New_Function_Call (Constr));

               --    if condition then
               --      exit;
               --    end if;
               Open_Temp;
               Gen_Exit_When
                 (Label,
                  Chap7.Translate_Expression (Cond, Boolean_Type_Definition));
               Close_Temp;

               --  end loop;
               Finish_Loop_Stmt (Label);
            end;
         end if;

         --  wait_close;
         Start_Association (Constr, Ghdl_Process_Wait_Close);
         New_Procedure_Call (Constr);
      end Translate_Wait_Statement;

      --  Signal assignment.
      Signal_Assign_Line : Natural;
      procedure Gen_Simple_Signal_Assign_Non_Composite (Targ : Mnode;
                                                        Targ_Type : Iir;
                                                        Val : O_Enode)
      is
         Type_Info : Type_Info_Acc;
         Subprg : O_Dnode;
         Conv : O_Tnode;
         Assoc : O_Assoc_List;
      begin
         Type_Info := Get_Info (Targ_Type);
         case Type_Info.Type_Mode is
            when Type_Mode_B2 =>
               Subprg := Ghdl_Signal_Simple_Assign_B2;
               Conv := Ghdl_Bool_Type;
            when Type_Mode_E8 =>
               Subprg := Ghdl_Signal_Simple_Assign_E8;
               Conv := Ghdl_I32_Type;
            when Type_Mode_E32 =>
               Subprg := Ghdl_Signal_Simple_Assign_E32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_I32
              | Type_Mode_P32 =>
               Subprg := Ghdl_Signal_Simple_Assign_I32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_P64
              | Type_Mode_I64 =>
               Subprg := Ghdl_Signal_Simple_Assign_I64;
               Conv := Ghdl_I64_Type;
            when Type_Mode_F64 =>
               Subprg := Ghdl_Signal_Simple_Assign_F64;
               Conv := Ghdl_Real_Type;
            when Type_Mode_Array =>
               raise Internal_Error;
            when others =>
               Error_Kind ("gen_signal_assign_non_composite", Targ_Type);
         end case;
         if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then
            declare
               If_Blk : O_If_Block;
               Val2 : O_Dnode;
               Targ2 : O_Dnode;
            begin
               Open_Temp;
               Val2 := Create_Temp_Init
                 (Type_Info.Ortho_Type (Mode_Value), Val);
               Targ2 := Create_Temp_Init
                 (Ghdl_Signal_Ptr, New_Convert_Ov (New_Value (M2Lv (Targ)),
                                                   Ghdl_Signal_Ptr));
               Start_If_Stmt (If_Blk, Chap3.Not_In_Range (Val2, Targ_Type));
               Start_Association (Assoc, Ghdl_Signal_Simple_Assign_Error);
               New_Association (Assoc, New_Obj_Value (Targ2));
               Assoc_Filename_Line (Assoc, Signal_Assign_Line);
               New_Procedure_Call (Assoc);
               New_Else_Stmt (If_Blk);
               Start_Association (Assoc, Subprg);
               New_Association (Assoc, New_Obj_Value (Targ2));
               New_Association
                 (Assoc, New_Convert_Ov (New_Obj_Value (Val2), Conv));
               New_Procedure_Call (Assoc);
               Finish_If_Stmt (If_Blk);
               Close_Temp;
            end;
         else
            Start_Association (Assoc, Subprg);
            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
                                                    Ghdl_Signal_Ptr));
            New_Association (Assoc, New_Convert_Ov (Val, Conv));
            New_Procedure_Call (Assoc);
         end if;
      end Gen_Simple_Signal_Assign_Non_Composite;

      procedure Gen_Simple_Signal_Assign is new Foreach_Non_Composite
        (Data_Type => O_Enode,
         Composite_Data_Type => Mnode,
         Do_Non_Composite => Gen_Simple_Signal_Assign_Non_Composite,
         Prepare_Data_Array => Gen_Oenode_Prepare_Data_Composite,
         Update_Data_Array => Gen_Oenode_Update_Data_Array,
         Finish_Data_Array => Gen_Oenode_Finish_Data_Composite,
         Prepare_Data_Record => Gen_Oenode_Prepare_Data_Composite,
         Update_Data_Record => Gen_Oenode_Update_Data_Record,
         Finish_Data_Record => Gen_Oenode_Finish_Data_Composite);

      type Signal_Assign_Data is record
         Expr : Mnode;
         Reject : O_Dnode;
         After : O_Dnode;
      end record;

      procedure Gen_Start_Signal_Assign_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Signal_Assign_Data)
      is
         Type_Info : Type_Info_Acc;
         Subprg : O_Dnode;
         Conv : O_Tnode;
         Assoc : O_Assoc_List;
      begin
         if Data.Expr = Mnode_Null then
            --  Null transaction.
            Start_Association (Assoc, Ghdl_Signal_Start_Assign_Null);
            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
                                                    Ghdl_Signal_Ptr));
            New_Association (Assoc, New_Obj_Value (Data.Reject));
            New_Association (Assoc, New_Obj_Value (Data.After));
            New_Procedure_Call (Assoc);
            return;
         end if;

         Type_Info := Get_Info (Targ_Type);
         case Type_Info.Type_Mode is
            when Type_Mode_B2 =>
               Subprg := Ghdl_Signal_Start_Assign_B2;
               Conv := Ghdl_Bool_Type;
            when Type_Mode_E8 =>
               Subprg := Ghdl_Signal_Start_Assign_E8;
               Conv := Ghdl_I32_Type;
            when Type_Mode_E32 =>
               Subprg := Ghdl_Signal_Start_Assign_E32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_I32
              | Type_Mode_P32 =>
               Subprg := Ghdl_Signal_Start_Assign_I32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_P64
              | Type_Mode_I64 =>
               Subprg := Ghdl_Signal_Start_Assign_I64;
               Conv := Ghdl_I64_Type;
            when Type_Mode_F64 =>
               Subprg := Ghdl_Signal_Start_Assign_F64;
               Conv := Ghdl_Real_Type;
            when Type_Mode_Array =>
               raise Internal_Error;
            when others =>
               Error_Kind ("gen_signal_assign_non_composite", Targ_Type);
         end case;
         --  Check range.
         if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then
            declare
               If_Blk : O_If_Block;
               V : Mnode;
               Starg : O_Dnode;
            begin
               Open_Temp;
               V := Stabilize_Value (Data.Expr);
               Starg := Create_Temp_Init
                 (Ghdl_Signal_Ptr,
                  New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
               Start_If_Stmt
                 (If_Blk, Chap3.Not_In_Range (M2Dv (V), Targ_Type));
               Start_Association (Assoc, Ghdl_Signal_Start_Assign_Error);
               New_Association (Assoc, New_Obj_Value (Starg));
               New_Association (Assoc, New_Obj_Value (Data.Reject));
               New_Association (Assoc, New_Obj_Value (Data.After));
               Assoc_Filename_Line (Assoc, Signal_Assign_Line);
               New_Procedure_Call (Assoc);
               New_Else_Stmt (If_Blk);
               Start_Association (Assoc, Subprg);
               New_Association (Assoc, New_Obj_Value (Starg));
               New_Association (Assoc, New_Obj_Value (Data.Reject));
               New_Association (Assoc, New_Convert_Ov (M2E (V), Conv));
               New_Association (Assoc, New_Obj_Value (Data.After));
               New_Procedure_Call (Assoc);
               Finish_If_Stmt (If_Blk);
               Close_Temp;
            end;
         else
            Start_Association (Assoc, Subprg);
            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
                                                    Ghdl_Signal_Ptr));
            New_Association (Assoc, New_Obj_Value (Data.Reject));
            New_Association (Assoc, New_Convert_Ov (M2E (Data.Expr), Conv));
            New_Association (Assoc, New_Obj_Value (Data.After));
            New_Procedure_Call (Assoc);
         end if;
      end Gen_Start_Signal_Assign_Non_Composite;

      function Gen_Signal_Prepare_Data_Composite
        (Targ : Mnode; Targ_Type : Iir; Val : Signal_Assign_Data)
        return Signal_Assign_Data
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Val;
      end Gen_Signal_Prepare_Data_Composite;

      function Gen_Signal_Prepare_Data_Record
        (Targ : Mnode; Targ_Type : Iir; Val : Signal_Assign_Data)
        return Signal_Assign_Data
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         if Val.Expr = Mnode_Null then
            return Val;
         else
            return Signal_Assign_Data'
              (Expr => Stabilize (Val.Expr),
               Reject => Val.Reject,
               After => Val.After);
         end if;
      end Gen_Signal_Prepare_Data_Record;

      function Gen_Signal_Update_Data_Array
        (Val : Signal_Assign_Data;
         Targ_Type : Iir;
         Index : O_Dnode)
        return Signal_Assign_Data
      is
         Res : Signal_Assign_Data;
      begin
         if Val.Expr = Mnode_Null then
            --  Handle null transaction.
            return Val;
         end if;
         Res := Signal_Assign_Data'
           (Expr => Chap3.Index_Base (Chap3.Get_Array_Base (Val.Expr),
                                      Targ_Type, New_Obj_Value (Index)),
            Reject => Val.Reject,
            After => Val.After);
         return Res;
      end Gen_Signal_Update_Data_Array;

      function Gen_Signal_Update_Data_Record
        (Val : Signal_Assign_Data;
         Targ_Type : Iir;
         El : Iir_Element_Declaration)
        return Signal_Assign_Data
      is
         pragma Unreferenced (Targ_Type);
         Res : Signal_Assign_Data;
      begin
         if Val.Expr = Mnode_Null then
            --  Handle null transaction.
            return Val;
         end if;
         Res := Signal_Assign_Data'
           (Expr => Chap6.Translate_Selected_Element (Val.Expr, El),
            Reject => Val.Reject,
            After => Val.After);
         return Res;
      end Gen_Signal_Update_Data_Record;

      procedure Gen_Signal_Finish_Data_Composite
        (Data : in out Signal_Assign_Data)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Gen_Signal_Finish_Data_Composite;

      procedure Gen_Start_Signal_Assign is new Foreach_Non_Composite
        (Data_Type => Signal_Assign_Data,
         Composite_Data_Type => Signal_Assign_Data,
         Do_Non_Composite => Gen_Start_Signal_Assign_Non_Composite,
         Prepare_Data_Array => Gen_Signal_Prepare_Data_Composite,
         Update_Data_Array => Gen_Signal_Update_Data_Array,
         Finish_Data_Array => Gen_Signal_Finish_Data_Composite,
         Prepare_Data_Record => Gen_Signal_Prepare_Data_Record,
         Update_Data_Record => Gen_Signal_Update_Data_Record,
         Finish_Data_Record => Gen_Signal_Finish_Data_Composite);

      procedure Gen_Next_Signal_Assign_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Signal_Assign_Data)
      is
         Type_Info : Type_Info_Acc;
         Subprg : O_Dnode;
         Conv : O_Tnode;
         Assoc : O_Assoc_List;
      begin
         if Data.Expr = Mnode_Null then
            --  Null transaction.
            Start_Association (Assoc, Ghdl_Signal_Next_Assign_Null);
            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
                                                    Ghdl_Signal_Ptr));
            New_Association (Assoc, New_Obj_Value (Data.After));
            New_Procedure_Call (Assoc);
            return;
         end if;

         Type_Info := Get_Info (Targ_Type);
         case Type_Info.Type_Mode is
            when Type_Mode_B2 =>
               Subprg := Ghdl_Signal_Next_Assign_B2;
               Conv := Ghdl_Bool_Type;
            when Type_Mode_E8 =>
               Subprg := Ghdl_Signal_Next_Assign_E8;
               Conv := Ghdl_I32_Type;
            when Type_Mode_E32 =>
               Subprg := Ghdl_Signal_Next_Assign_E32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_I32
              | Type_Mode_P32 =>
               Subprg := Ghdl_Signal_Next_Assign_I32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_P64
              | Type_Mode_I64 =>
               Subprg := Ghdl_Signal_Next_Assign_I64;
               Conv := Ghdl_I64_Type;
            when Type_Mode_F64 =>
               Subprg := Ghdl_Signal_Next_Assign_F64;
               Conv := Ghdl_Real_Type;
            when Type_Mode_Array =>
               raise Internal_Error;
            when others =>
               Error_Kind ("gen_signal_next_assign_non_composite", Targ_Type);
         end case;
         if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then
            declare
               If_Blk : O_If_Block;
               V : Mnode;
               Starg : O_Dnode;
            begin
               Open_Temp;
               V := Stabilize_Value (Data.Expr);
               Starg := Create_Temp_Init
                 (Ghdl_Signal_Ptr,
                  New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
               Start_If_Stmt
                 (If_Blk, Chap3.Not_In_Range (M2Dv (V), Targ_Type));

               Start_Association (Assoc, Ghdl_Signal_Next_Assign_Error);
               New_Association (Assoc, New_Obj_Value (Starg));
               New_Association (Assoc, New_Obj_Value (Data.After));
               Assoc_Filename_Line (Assoc, Signal_Assign_Line);
               New_Procedure_Call (Assoc);

               New_Else_Stmt (If_Blk);

               Start_Association (Assoc, Subprg);
               New_Association (Assoc, New_Obj_Value (Starg));
               New_Association (Assoc, New_Convert_Ov (M2E (V), Conv));
               New_Association (Assoc, New_Obj_Value (Data.After));
               New_Procedure_Call (Assoc);

               Finish_If_Stmt (If_Blk);
               Close_Temp;
            end;
         else
            Start_Association (Assoc, Subprg);
            New_Association (Assoc, New_Convert_Ov (New_Value (M2Lv (Targ)),
                                                    Ghdl_Signal_Ptr));
            New_Association (Assoc, New_Convert_Ov (M2E (Data.Expr), Conv));
            New_Association (Assoc, New_Obj_Value (Data.After));
            New_Procedure_Call (Assoc);
         end if;
      end Gen_Next_Signal_Assign_Non_Composite;

      procedure Gen_Next_Signal_Assign is new Foreach_Non_Composite
        (Data_Type => Signal_Assign_Data,
         Composite_Data_Type => Signal_Assign_Data,
         Do_Non_Composite => Gen_Next_Signal_Assign_Non_Composite,
         Prepare_Data_Array => Gen_Signal_Prepare_Data_Composite,
         Update_Data_Array => Gen_Signal_Update_Data_Array,
         Finish_Data_Array => Gen_Signal_Finish_Data_Composite,
         Prepare_Data_Record => Gen_Signal_Prepare_Data_Record,
         Update_Data_Record => Gen_Signal_Update_Data_Record,
         Finish_Data_Record => Gen_Signal_Finish_Data_Composite);

      procedure Translate_Signal_Target_Aggr
        (Aggr : Mnode; Target : Iir; Target_Type : Iir);

      procedure Translate_Signal_Target_Array_Aggr
        (Aggr : Mnode;
         Target : Iir;
         Target_Type : Iir;
         Idx : O_Dnode;
         Dim : Natural)
      is
         Index_List : constant Iir_List :=
           Get_Index_Subtype_List (Target_Type);
         Nbr_Dim : constant Natural := Get_Nbr_Elements (Index_List);
         Sub_Aggr : Mnode;
         El : Iir;
         Expr : Iir;
      begin
         El := Get_Association_Choices_Chain (Target);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Choice_By_None =>
                  Sub_Aggr := Chap3.Index_Base
                    (Aggr, Target_Type, New_Obj_Value (Idx));
               when others =>
                  Error_Kind ("translate_signal_target_array_aggr", El);
            end case;
            Expr := Get_Associated (El);
            if Dim = Nbr_Dim then
               Translate_Signal_Target_Aggr
                 (Sub_Aggr, Expr, Get_Element_Subtype (Target_Type));
               if Get_Kind (El) = Iir_Kind_Choice_By_None then
                  Inc_Var (Idx);
               else
                  raise Internal_Error;
               end if;
            else
               Translate_Signal_Target_Array_Aggr
                 (Sub_Aggr, Expr, Target_Type, Idx, Dim + 1);
            end if;
            El := Get_Chain (El);
         end loop;
      end Translate_Signal_Target_Array_Aggr;

      procedure Translate_Signal_Target_Record_Aggr
        (Aggr : Mnode; Target : Iir; Target_Type : Iir)
      is
         Aggr_El : Iir;
         El_List : Iir_List;
         El_Index : Natural;
         Element : Iir_Element_Declaration;
      begin
         El_List := Get_Elements_Declaration_List
           (Get_Base_Type (Target_Type));
         El_Index := 0;
         Aggr_El := Get_Association_Choices_Chain (Target);
         while Aggr_El /= Null_Iir loop
            case Get_Kind (Aggr_El) is
               when Iir_Kind_Choice_By_None =>
                  Element := Get_Nth_Element (El_List, El_Index);
                  El_Index := El_Index + 1;
               when Iir_Kind_Choice_By_Name =>
                  Element := Get_Name (Aggr_El);
                  El_Index := Natural'Last;
               when others =>
                  Error_Kind ("translate_signal_target_record_aggr", Aggr_El);
            end case;
            Translate_Signal_Target_Aggr
              (Chap6.Translate_Selected_Element (Aggr, Element),
               Get_Associated (Aggr_El), Get_Type (Element));
            Aggr_El := Get_Chain (Aggr_El);
         end loop;
      end Translate_Signal_Target_Record_Aggr;

      procedure Translate_Signal_Target_Aggr
        (Aggr : Mnode; Target : Iir; Target_Type : Iir)
      is
         Src : Mnode;
      begin
         if Get_Kind (Target) = Iir_Kind_Aggregate then
            declare
               Idx : O_Dnode;
               St_Aggr : Mnode;
            begin
               Open_Temp;
               St_Aggr := Stabilize (Aggr);
               case Get_Kind (Target_Type) is
                  when Iir_Kinds_Array_Type_Definition =>
                     Idx := Create_Temp (Ghdl_Index_Type);
                     Init_Var (Idx);
                     Translate_Signal_Target_Array_Aggr
                       (St_Aggr, Target, Target_Type, Idx, 1);
                  when Iir_Kind_Record_Type_Definition
                    | Iir_Kind_Record_Subtype_Definition =>
                     Translate_Signal_Target_Record_Aggr
                       (St_Aggr, Target, Target_Type);
                  when others =>
                     Error_Kind ("translate_signal_target_aggr", Target_Type);
               end case;
               Close_Temp;
            end;
         else
            Src := Chap6.Translate_Name (Target);
            Chap3.Translate_Object_Copy (Aggr, M2E (Src), Target_Type);
         end if;
      end Translate_Signal_Target_Aggr;

      type Signal_Direct_Assign_Data is record
         --  The driver
         Drv : Mnode;

         --  The value
         Expr : Mnode;

         --  The node for the expression (used to locate errors).
         Expr_Node : Iir;
      end record;

      procedure Gen_Signal_Direct_Assign_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Signal_Direct_Assign_Data)
      is
         Targ_Sig : Mnode;
         If_Blk : O_If_Block;
         Constr : O_Assoc_List;
         Cond : O_Dnode;
         Drv : Mnode;
      begin
         Open_Temp;
         Targ_Sig := Stabilize (Targ, True);
         Cond := Create_Temp (Ghdl_Bool_Type);
         Drv := Stabilize (Data.Drv, False);

         --  Set driver.
         Chap7.Translate_Assign
           (Drv, M2E (Data.Expr), Data.Expr_Node, Targ_Type, Data.Expr_Node);

         --  Test if the signal is active.
         Start_If_Stmt
           (If_Blk,
            New_Value (Chap14.Get_Signal_Field
                       (Targ_Sig, Ghdl_Signal_Has_Active_Field)));
         --  Either because has_active is true.
         New_Assign_Stmt (New_Obj (Cond),
                          New_Lit (Ghdl_Bool_True_Node));
         New_Else_Stmt (If_Blk);
         --  Or because the value is different from the current driving value.
         --  FIXME: ideally, we should compare the value with the current
         --   value of the driver. This is an approximation that might break
         --   with weird resolution functions.
         New_Assign_Stmt
           (New_Obj (Cond),
            New_Compare_Op (ON_Neq,
                            Chap7.Translate_Signal_Driving_Value
                              (M2E (Targ_Sig), Targ_Type),
                            M2E (Drv),
                            Ghdl_Bool_Type));
         Finish_If_Stmt (If_Blk);

         --  Put signal into active list (if not already in the list).
         --  FIXME: this is not thread-safe!
         Start_If_Stmt (If_Blk, New_Obj_Value (Cond));
         Start_Association (Constr, Ghdl_Signal_Direct_Assign);
         New_Association (Constr,
                          New_Convert_Ov (New_Value (M2Lv (Targ_Sig)),
                                          Ghdl_Signal_Ptr));
         New_Procedure_Call (Constr);
         Finish_If_Stmt (If_Blk);

         Close_Temp;
      end Gen_Signal_Direct_Assign_Non_Composite;

      function Gen_Signal_Direct_Prepare_Data_Composite
        (Targ : Mnode; Targ_Type : Iir; Val : Signal_Direct_Assign_Data)
        return Signal_Direct_Assign_Data
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Val;
      end Gen_Signal_Direct_Prepare_Data_Composite;

      function Gen_Signal_Direct_Prepare_Data_Record
        (Targ : Mnode; Targ_Type : Iir; Val : Signal_Direct_Assign_Data)
        return Signal_Direct_Assign_Data
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Signal_Direct_Assign_Data'
           (Drv => Stabilize (Val.Drv),
            Expr => Stabilize (Val.Expr),
            Expr_Node => Val.Expr_Node);
      end Gen_Signal_Direct_Prepare_Data_Record;

      function Gen_Signal_Direct_Update_Data_Array
        (Val : Signal_Direct_Assign_Data;
         Targ_Type : Iir;
         Index : O_Dnode)
        return Signal_Direct_Assign_Data
      is
      begin
         return Signal_Direct_Assign_Data'
           (Drv => Chap3.Index_Base (Chap3.Get_Array_Base (Val.Drv),
                                     Targ_Type, New_Obj_Value (Index)),
            Expr => Chap3.Index_Base (Chap3.Get_Array_Base (Val.Expr),
                                      Targ_Type, New_Obj_Value (Index)),
            Expr_Node => Val.Expr_Node);
      end Gen_Signal_Direct_Update_Data_Array;

      function Gen_Signal_Direct_Update_Data_Record
        (Val : Signal_Direct_Assign_Data;
         Targ_Type : Iir;
         El : Iir_Element_Declaration)
        return Signal_Direct_Assign_Data
      is
         pragma Unreferenced (Targ_Type);
      begin
         return Signal_Direct_Assign_Data'
           (Drv => Chap6.Translate_Selected_Element (Val.Drv, El),
            Expr => Chap6.Translate_Selected_Element (Val.Expr, El),
            Expr_Node => Val.Expr_Node);
      end Gen_Signal_Direct_Update_Data_Record;

      procedure Gen_Signal_Direct_Finish_Data_Composite
        (Data : in out Signal_Direct_Assign_Data)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Gen_Signal_Direct_Finish_Data_Composite;

      procedure Gen_Signal_Direct_Assign is new Foreach_Non_Composite
        (Data_Type => Signal_Direct_Assign_Data,
         Composite_Data_Type => Signal_Direct_Assign_Data,
         Do_Non_Composite => Gen_Signal_Direct_Assign_Non_Composite,
         Prepare_Data_Array => Gen_Signal_Direct_Prepare_Data_Composite,
         Update_Data_Array => Gen_Signal_Direct_Update_Data_Array,
         Finish_Data_Array => Gen_Signal_Direct_Finish_Data_Composite,
         Prepare_Data_Record => Gen_Signal_Direct_Prepare_Data_Record,
         Update_Data_Record => Gen_Signal_Direct_Update_Data_Record,
         Finish_Data_Record => Gen_Signal_Direct_Finish_Data_Composite);

      procedure Translate_Direct_Signal_Assignment (Stmt : Iir; We : Iir)
      is
         Target : constant Iir := Get_Target (Stmt);
         Target_Type : constant Iir := Get_Type (Target);
         Arg : Signal_Direct_Assign_Data;
         Targ_Sig : Mnode;
      begin
         Chap6.Translate_Direct_Driver (Target, Targ_Sig, Arg.Drv);

         Arg.Expr := E2M (Chap7.Translate_Expression (We, Target_Type),
                          Get_Info (Target_Type), Mode_Value);
         Arg.Expr_Node := We;
         Gen_Signal_Direct_Assign (Targ_Sig, Target_Type, Arg);
      end Translate_Direct_Signal_Assignment;

      procedure Translate_Signal_Assignment_Statement (Stmt : Iir)
      is
         Target : Iir;
         Target_Type : Iir;
         We : Iir_Waveform_Element;
         Targ : Mnode;
         Val : O_Enode;
         Value : Iir;
         Is_Simple : Boolean;
      begin
         Target := Get_Target (Stmt);
         Target_Type := Get_Type (Target);
         We := Get_Waveform_Chain (Stmt);

         if We /= Null_Iir
           and then Get_Chain (We) = Null_Iir
           and then Get_Time (We) = Null_Iir
           and then Get_Delay_Mechanism (Stmt) = Iir_Inertial_Delay
           and then Get_Reject_Time_Expression (Stmt) = Null_Iir
         then
            --  Simple signal assignment ?
            Value := Get_We_Value (We);
            Is_Simple := Get_Kind (Value) /= Iir_Kind_Null_Literal;
         else
            Is_Simple := False;
         end if;

         if Get_Kind (Target) = Iir_Kind_Aggregate then
            Chap3.Translate_Anonymous_Type_Definition (Target_Type, True);
            Targ := Create_Temp (Get_Info (Target_Type), Mode_Signal);
            Chap4.Allocate_Complex_Object (Target_Type, Alloc_Stack, Targ);
            Translate_Signal_Target_Aggr (Targ, Target, Target_Type);
         else
            if Is_Simple
              and then Flag_Direct_Drivers
              and then Chap4.Has_Direct_Driver (Target)
            then
               Translate_Direct_Signal_Assignment (Stmt, Value);
               return;
            end if;
            Targ := Chap6.Translate_Name (Target);
            if Get_Object_Kind (Targ) /= Mode_Signal then
               raise Internal_Error;
            end if;
         end if;

         if We = Null_Iir then
            --  Implicit disconnect statment.
            Register_Signal (Targ, Target_Type, Ghdl_Signal_Disconnect);
            return;
         end if;

         --  Handle a simple and common case: only one waveform, inertial,
         --  and no time (eg: sig <= expr).
         Value := Get_We_Value (We);
         Signal_Assign_Line := Get_Line_Number (Value);
         if Get_Chain (We) = Null_Iir
           and then Get_Time (We) = Null_Iir
           and then Get_Delay_Mechanism (Stmt) = Iir_Inertial_Delay
           and then Get_Reject_Time_Expression (Stmt) = Null_Iir
           and then Get_Kind (Value) /= Iir_Kind_Null_Literal
         then
            Val := Chap7.Translate_Expression (Value, Target_Type);
            Gen_Simple_Signal_Assign (Targ, Target_Type, Val);
            return;
         end if;

         --  General case.
         declare
            Var_Targ : Mnode;
            Targ_Tinfo : Type_Info_Acc;
         begin
            Open_Temp;
            Targ_Tinfo := Get_Info (Target_Type);
            Var_Targ := Stabilize (Targ, True);

            --  Translate the first waveform element.
            declare
               Reject_Time : O_Dnode;
               After_Time : O_Dnode;
               Del : Iir;
               Rej : Iir;
               Val : Mnode;
               Data : Signal_Assign_Data;
            begin
               Open_Temp;
               Reject_Time := Create_Temp (Std_Time_Type);
               After_Time := Create_Temp (Std_Time_Type);
               Del := Get_Time (We);
               if Del = Null_Iir then
                  New_Assign_Stmt
                    (New_Obj (After_Time),
                     New_Lit (New_Signed_Literal (Std_Time_Type, 0)));
               else
                  New_Assign_Stmt
                    (New_Obj (After_Time),
                     Chap7.Translate_Expression (Del, Time_Type_Definition));
               end if;
               case Get_Delay_Mechanism (Stmt) is
                  when Iir_Transport_Delay =>
                     New_Assign_Stmt
                       (New_Obj (Reject_Time),
                        New_Lit (New_Signed_Literal (Std_Time_Type, 0)));
                  when Iir_Inertial_Delay =>
                     Rej := Get_Reject_Time_Expression (Stmt);
                     if Rej = Null_Iir then
                        New_Assign_Stmt (New_Obj (Reject_Time),
                                         New_Obj_Value (After_Time));
                     else
                        New_Assign_Stmt
                          (New_Obj (Reject_Time), Chap7.Translate_Expression
                           (Rej, Time_Type_Definition));
                     end if;
               end case;
               if Get_Kind (Value) = Iir_Kind_Null_Literal then
                  Val := Mnode_Null;
               else
                  Val := E2M (Chap7.Translate_Expression (Value, Target_Type),
                              Targ_Tinfo, Mode_Value);
                  Val := Stabilize (Val);
               end if;
               Data := Signal_Assign_Data'(Expr => Val,
                                           Reject => Reject_Time,
                                           After => After_Time);
               Gen_Start_Signal_Assign (Var_Targ, Target_Type, Data);
               Close_Temp;
            end;

            --  Translate other waveform elements.
            We := Get_Chain (We);
            while We /= Null_Iir loop
               declare
                  After_Time : O_Dnode;
                  Val : Mnode;
                  Data : Signal_Assign_Data;
               begin
                  Open_Temp;
                  After_Time := Create_Temp (Std_Time_Type);
                  New_Assign_Stmt
                    (New_Obj (After_Time),
                     Chap7.Translate_Expression (Get_Time (We),
                                                 Time_Type_Definition));
                  Value := Get_We_Value (We);
                  Signal_Assign_Line := Get_Line_Number (Value);
                  if Get_Kind (Value) = Iir_Kind_Null_Literal then
                     Val := Mnode_Null;
                  else
                     Val :=
                       E2M (Chap7.Translate_Expression (Value, Target_Type),
                            Targ_Tinfo, Mode_Value);
                  end if;
                  Data := Signal_Assign_Data'(Expr => Val,
                                              Reject => O_Dnode_Null,
                                              After => After_Time);
                  Gen_Next_Signal_Assign (Var_Targ, Target_Type, Data);
                  Close_Temp;
               end;
               We := Get_Chain (We);
            end loop;

            Close_Temp;
         end;
      end Translate_Signal_Assignment_Statement;

      procedure Translate_Statement (Stmt : Iir)
      is
      begin
         New_Debug_Line_Stmt (Get_Line_Number (Stmt));
         Open_Temp;
         case Get_Kind (Stmt) is
            when Iir_Kind_Return_Statement =>
               Translate_Return_Statement (Stmt);

            when Iir_Kind_If_Statement =>
               Translate_If_Statement (Stmt);
            when Iir_Kind_Assertion_Statement =>
               Translate_Assertion_Statement (Stmt);
            when Iir_Kind_Report_Statement =>
               Translate_Report_Statement (Stmt);
            when Iir_Kind_Case_Statement =>
               Translate_Case_Statement (Stmt);

            when Iir_Kind_For_Loop_Statement =>
               Translate_For_Loop_Statement (Stmt);
            when Iir_Kind_While_Loop_Statement =>
               Translate_While_Loop_Statement (Stmt);
            when Iir_Kind_Next_Statement
              | Iir_Kind_Exit_Statement =>
               Translate_Exit_Next_Statement (Stmt);

            when Iir_Kind_Signal_Assignment_Statement =>
               Translate_Signal_Assignment_Statement (Stmt);
            when Iir_Kind_Variable_Assignment_Statement =>
               Translate_Variable_Assignment_Statement (Stmt);

            when Iir_Kind_Null_Statement =>
               --  A null statement is translated to a NOP, so that the
               --  statement generates code (and a breakpoint can be set on
               --  it).
               --  Emit_Nop;
               null;

            when Iir_Kind_Procedure_Call_Statement =>
               declare
                  Call : constant Iir := Get_Procedure_Call (Stmt);
                  Imp : constant Iir :=
                    Get_Named_Entity (Get_Implementation (Call));
               begin
                  Canon.Canon_Subprogram_Call (Call);
                  if Get_Kind (Imp) = Iir_Kind_Implicit_Procedure_Declaration
                  then
                     Translate_Implicit_Procedure_Call (Call);
                  else
                     Translate_Procedure_Call (Call);
                  end if;
               end;

            when Iir_Kind_Wait_Statement =>
               Translate_Wait_Statement (Stmt);

            when others =>
               Error_Kind ("translate_statement", Stmt);
         end case;
         Close_Temp;
      end Translate_Statement;

      procedure Translate_Statements_Chain (First : Iir)
      is
         Stmt : Iir;
      begin
         Stmt := First;
         while Stmt /= Null_Iir loop
            Translate_Statement (Stmt);
            Stmt := Get_Chain (Stmt);
         end loop;
      end Translate_Statements_Chain;

      function Translate_Statements_Chain_Has_Return (First : Iir)
                                                     return Boolean
      is
         Stmt : Iir;
         Has_Return : Boolean := False;
      begin
         Stmt := First;
         while Stmt /= Null_Iir loop
            Translate_Statement (Stmt);
            if Get_Kind (Stmt) = Iir_Kind_Return_Statement then
               Has_Return := True;
            end if;
            Stmt := Get_Chain (Stmt);
         end loop;
         return Has_Return;
      end Translate_Statements_Chain_Has_Return;
   end Chap8;

   package body Chap9 is
      procedure Set_Direct_Drivers (Proc : Iir)
      is
         Proc_Info : constant Proc_Info_Acc := Get_Info (Proc);
         Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers;
         Info : Ortho_Info_Acc;
         Var : Var_Acc;
         Sig : Iir;
      begin
         for I in Drivers.all'Range loop
            Var := Drivers (I).Var;
            if Var /= null then
               Sig := Get_Object_Prefix (Drivers (I).Sig);
               Info := Get_Info (Sig);
               case Info.Kind is
                  when Kind_Object =>
                     Info.Object_Driver := Var;
                  when Kind_Alias =>
                     null;
                  when others =>
                     raise Internal_Error;
               end case;
            end if;
         end loop;
      end Set_Direct_Drivers;

      procedure Reset_Direct_Drivers (Proc : Iir)
      is
         Proc_Info : constant Proc_Info_Acc := Get_Info (Proc);
         Drivers : constant Direct_Drivers_Acc := Proc_Info.Process_Drivers;
         Info : Ortho_Info_Acc;
         Var : Var_Acc;
         Sig : Iir;
      begin
         for I in Drivers.all'Range loop
            Var := Drivers (I).Var;
            if Var /= null then
               Sig := Get_Object_Prefix (Drivers (I).Sig);
               Info := Get_Info (Sig);
               case Info.Kind is
                  when Kind_Object =>
                     Info.Object_Driver := null;
                  when Kind_Alias =>
                     null;
                  when others =>
                     raise Internal_Error;
               end case;
            end if;
         end loop;
      end Reset_Direct_Drivers;

      procedure Translate_Process_Statement (Proc : Iir; Base : Block_Info_Acc)
      is
         Inter_List : O_Inter_List;
         Instance : O_Dnode;
         Info : Proc_Info_Acc;
      begin
         Info := Get_Info (Proc);
         Start_Procedure_Decl (Inter_List, Create_Identifier ("PROC"),
                               O_Storage_Private);
         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
                             Base.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Info.Process_Subprg);

         Start_Subprogram_Body (Info.Process_Subprg);
         Push_Local_Factory;
         --  Push scope for architecture declarations.
         Push_Scope (Base.Block_Decls_Type, Instance);

         Chap8.Translate_Statements_Chain
           (Get_Sequential_Statement_Chain (Proc));

         Pop_Scope (Base.Block_Decls_Type);
         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Translate_Process_Statement;

      procedure Translate_Implicit_Guard_Signal
        (Guard : Iir; Base : Block_Info_Acc)
      is
         Info : Object_Info_Acc;
         Inter_List : O_Inter_List;
         Instance : O_Dnode;
         Guard_Expr : Iir;
      begin
         Guard_Expr := Get_Guard_Expression (Guard);
         --  Create the subprogram to compute the value of GUARD.
         Info := Get_Info (Guard);
         Start_Function_Decl (Inter_List, Create_Identifier ("_GUARD_PROC"),
                              O_Storage_Private, Std_Boolean_Type_Node);
         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
                             Base.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Info.Object_Function);

         Start_Subprogram_Body (Info.Object_Function);
         Push_Local_Factory;
         Push_Scope (Base.Block_Decls_Type, Instance);
         Open_Temp;
         New_Return_Stmt (Chap7.Translate_Expression (Guard_Expr));
         Close_Temp;
         Pop_Scope (Base.Block_Decls_Type);
         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Translate_Implicit_Guard_Signal;

      procedure Translate_Component_Instantiation_Statement (Inst : Iir)
      is
         Comp : constant Iir := Get_Instantiated_Unit (Inst);
         Info : Block_Info_Acc;
         Comp_Info : Comp_Info_Acc;

         Mark2 : Id_Mark_Type;
         Assoc, Conv, In_Type : Iir;
         Has_Conv_Record : Boolean := False;
      begin
         Info := Add_Info (Inst, Kind_Block);
         Info.Block_Decls_Type := O_Tnode_Null;
         if Get_Kind (Comp) in Iir_Kinds_Denoting_Name then
            --  Via a component declaration.
            Comp_Info := Get_Info (Get_Named_Entity (Comp));
            Info.Block_Link_Field := Add_Instance_Factory_Field
              (Create_Identifier_Without_Prefix (Inst),
               Comp_Info.Comp_Type);
         else
            --  Direct instantiation.
            Info.Block_Link_Field := Add_Instance_Factory_Field
              (Create_Identifier_Without_Prefix (Inst),
               Rtis.Ghdl_Component_Link_Type);
         end if;

         --  When conversions are used, the subtype of the actual (or of the
         --  formal for out conversions) may not be yet translated.  This
         --  can happen if the name is a slice.
         --  We need to translate it and create variables in the instance
         --  because it will be referenced by the conversion subprogram.
         Assoc := Get_Port_Map_Aspect_Chain (Inst);
         while Assoc /= Null_Iir loop
            if Get_Kind (Assoc) = Iir_Kind_Association_Element_By_Expression
            then
               Conv := Get_In_Conversion (Assoc);
               In_Type := Get_Type (Get_Actual (Assoc));
               if Conv /= Null_Iir
                 and then Is_Anonymous_Type_Definition (In_Type)
               then
                  --  Lazy creation of the record.
                  if not Has_Conv_Record then
                     Has_Conv_Record := True;
                     Push_Instance_Factory (O_Tnode_Null);
                  end if;

                  --  FIXME: handle with overload multiple case on the same
                  --  formal.
                  Push_Identifier_Prefix
                    (Mark2,
                     Get_Identifier (Get_Association_Interface (Assoc)));
                  Chap3.Translate_Type_Definition (In_Type, True);
                  Pop_Identifier_Prefix (Mark2);
               end if;
            end if;
            Assoc := Get_Chain (Assoc);
         end loop;
         if Has_Conv_Record then
            Pop_Instance_Factory (Info.Block_Decls_Type);
            New_Type_Decl
              (Create_Identifier (Get_Identifier (Inst), "__CONVS"),
               Info.Block_Decls_Type);
            Info.Block_Parent_Field := Add_Instance_Factory_Field
              (Create_Identifier_Without_Prefix (Get_Identifier (Inst),
                                                 "__CONVS"),
               Info.Block_Decls_Type);
         end if;
      end Translate_Component_Instantiation_Statement;

      procedure Translate_Process_Declarations (Proc : Iir)
      is
         Mark : Id_Mark_Type;
         Info : Ortho_Info_Acc;
         Itype : O_Tnode;
         Field : O_Fnode;

         Drivers : Iir_List;
         Nbr_Drivers : Natural;
         Sig : Iir;
      begin
         --  Create process record.
         Push_Identifier_Prefix (Mark, Get_Identifier (Proc));
         Push_Instance_Factory (O_Tnode_Null);
         Info := Add_Info (Proc, Kind_Process);
         Chap4.Translate_Declaration_Chain (Proc);

         if Flag_Direct_Drivers then
            --  Create direct drivers.
            Drivers := Trans_Analyzes.Extract_Drivers (Proc);
            if Flag_Dump_Drivers then
               Trans_Analyzes.Dump_Drivers (Proc, Drivers);
            end if;

            Nbr_Drivers := Get_Nbr_Elements (Drivers);
            Info.Process_Drivers := new Direct_Driver_Arr (1 .. Nbr_Drivers);
            for I in 1 .. Nbr_Drivers loop
               Sig := Get_Nth_Element (Drivers, I - 1);
               Info.Process_Drivers (I) := (Sig => Sig, Var => null);
               Sig := Get_Object_Prefix (Sig);
               if Get_Kind (Sig) /= Iir_Kind_Object_Alias_Declaration
                 and then not Get_After_Drivers_Flag (Sig)
               then
                  Info.Process_Drivers (I).Var :=
                    Create_Var (Create_Var_Identifier (Sig, "_DDRV", I),
                                Chap4.Get_Object_Type
                                (Get_Info (Get_Type (Sig)), Mode_Value));

                  --  Do not create driver severals times.
                  Set_After_Drivers_Flag (Sig, True);
               end if;
            end loop;
            Trans_Analyzes.Free_Drivers_List (Drivers);
         end if;
         Pop_Instance_Factory (Itype);
         New_Type_Decl (Create_Identifier ("INSTTYPE"), Itype);
         Pop_Identifier_Prefix (Mark);

         --  Create a field in the parent record.
         Field := Add_Instance_Factory_Field
           (Create_Identifier_Without_Prefix (Proc), Itype);

         --  Set info in child record.
         Info.Process_Decls_Type := Itype;
         Info.Process_Parent_Field := Field;
      end Translate_Process_Declarations;

      procedure Translate_Psl_Directive_Declarations (Stmt : Iir)
      is
         use PSL.Nodes;
         use PSL.NFAs;

         Mark : Id_Mark_Type;
         Info : Ortho_Info_Acc;
         Itype : O_Tnode;
         Field : O_Fnode;

         N : NFA;
      begin
         --  Create process record.
         Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
         Push_Instance_Factory (O_Tnode_Null);
         Info := Add_Info (Stmt, Kind_Psl_Directive);

         N := Get_PSL_NFA (Stmt);
         Labelize_States (N, Info.Psl_Vect_Len);
         Info.Psl_Vect_Type := New_Constrained_Array_Type
           (Std_Boolean_Array_Type,
            New_Unsigned_Literal (Ghdl_Index_Type,
                                  Unsigned_64 (Info.Psl_Vect_Len)));
         New_Type_Decl (Create_Identifier ("VECTTYPE"), Info.Psl_Vect_Type);
         Info.Psl_Vect_Var :=
           Create_Var (Create_Var_Identifier ("VECT"), Info.Psl_Vect_Type);

         if Get_Kind (Stmt) = Iir_Kind_Psl_Cover_Statement then
            Info.Psl_Bool_Var :=
              Create_Var (Create_Var_Identifier ("BOOL"), Ghdl_Bool_Type);
         end if;

         Pop_Instance_Factory (Itype);
         New_Type_Decl (Create_Identifier ("INSTTYPE"), Itype);
         Pop_Identifier_Prefix (Mark);

         --  Create a field in the parent record.
         Field := Add_Instance_Factory_Field
           (Create_Identifier_Without_Prefix (Stmt), Itype);

         --  Set info in child record.
         Info.Psl_Decls_Type := Itype;
         Info.Psl_Parent_Field := Field;
      end Translate_Psl_Directive_Declarations;

      function Translate_Psl_Expr (Expr : PSL_Node; Eos : Boolean)
                                  return O_Enode
      is
         use PSL.Nodes;
      begin
         case Get_Kind (Expr) is
            when N_HDL_Expr =>
               declare
                  E : Iir;
                  Rtype : Iir;
                  Res : O_Enode;
               begin
                  E := Get_HDL_Node (Expr);
                  Rtype := Get_Base_Type (Get_Type (E));
                  Res := Chap7.Translate_Expression (E);
                  if Rtype = Boolean_Type_Definition then
                     return Res;
                  elsif Rtype = Ieee.Std_Logic_1164.Std_Ulogic_Type then
                     return New_Value
                       (New_Indexed_Element
                          (New_Obj (Ghdl_Std_Ulogic_To_Boolean_Array),
                           New_Convert_Ov (Res, Ghdl_Index_Type)));
                  else
                     Error_Kind ("translate_psl_expr/hdl_expr", Expr);
                  end if;
               end;
            when N_True =>
               return New_Lit (Std_Boolean_True_Node);
            when N_EOS =>
               if Eos then
                  return New_Lit (Std_Boolean_True_Node);
               else
                  return New_Lit (Std_Boolean_False_Node);
               end if;
            when N_Not_Bool =>
               return New_Monadic_Op
                 (ON_Not,
                  Translate_Psl_Expr (Get_Boolean (Expr), Eos));
            when N_And_Bool =>
               return New_Dyadic_Op
                 (ON_And,
                  Translate_Psl_Expr (Get_Left (Expr), Eos),
                  Translate_Psl_Expr (Get_Right (Expr), Eos));
            when N_Or_Bool =>
               return New_Dyadic_Op
                 (ON_Or,
                  Translate_Psl_Expr (Get_Left (Expr), Eos),
                  Translate_Psl_Expr (Get_Right (Expr), Eos));
            when others =>
               Error_Kind ("translate_psl_expr", Expr);
         end case;
      end Translate_Psl_Expr;

      --  Return TRUE iff NFA has an edge with an EOS.
      --  If so, we need to create a finalizer.
      function Psl_Need_Finalizer (Nfa : PSL_NFA) return Boolean
      is
         use PSL.NFAs;
         S : NFA_State;
         E : NFA_Edge;
      begin
         S := Get_Final_State (Nfa);
         E := Get_First_Dest_Edge (S);
         while E /= No_Edge loop
            if PSL.NFAs.Utils.Has_EOS (Get_Edge_Expr (E)) then
               return True;
            end if;
            E := Get_Next_Dest_Edge (E);
         end loop;
         return False;
      end Psl_Need_Finalizer;

      procedure Create_Psl_Final_Proc
        (Stmt : Iir; Base : Block_Info_Acc; Instance : out O_Dnode)
      is
         Inter_List : O_Inter_List;
         Info : constant Psl_Info_Acc := Get_Info (Stmt);
      begin
         Start_Procedure_Decl (Inter_List, Create_Identifier ("FINALPROC"),
                               O_Storage_Private);
         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
                             Base.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Info.Psl_Proc_Final_Subprg);
      end Create_Psl_Final_Proc;

      procedure Translate_Psl_Directive_Statement
        (Stmt : Iir; Base : Block_Info_Acc)
      is
         use PSL.NFAs;
         Inter_List : O_Inter_List;
         Instance : O_Dnode;
         Info : constant Psl_Info_Acc := Get_Info (Stmt);
         Var_I : O_Dnode;
         Var_Nvec : O_Dnode;
         Label : O_Snode;
         Clk_Blk : O_If_Block;
         S_Blk : O_If_Block;
         E_Blk : O_If_Block;
         S : NFA_State;
         S_Num : Int32;
         E : NFA_Edge;
         Sd : NFA_State;
         Cond : O_Enode;
         NFA : PSL_NFA;
         D_Lit : O_Cnode;
      begin
         Start_Procedure_Decl (Inter_List, Create_Identifier ("PROC"),
                               O_Storage_Private);
         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
                             Base.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Info.Psl_Proc_Subprg);

         Start_Subprogram_Body (Info.Psl_Proc_Subprg);
         Push_Local_Factory;
         --  Push scope for architecture declarations.
         Push_Scope (Base.Block_Decls_Type, Instance);

         --  New state vector.
         New_Var_Decl (Var_Nvec, Wki_Res, O_Storage_Local, Info.Psl_Vect_Type);

         --  For cover directive, return now if already covered.
         case Get_Kind (Stmt) is
            when Iir_Kind_Psl_Assert_Statement =>
               null;
            when Iir_Kind_Psl_Cover_Statement =>
               Start_If_Stmt (S_Blk, New_Value (Get_Var (Info.Psl_Bool_Var)));
               New_Return_Stmt;
               Finish_If_Stmt (S_Blk);
            when others =>
               Error_Kind ("Translate_Psl_Directive_Statement(1)", Stmt);
         end case;

         --  Initialize the new state vector.
         Start_Declare_Stmt;
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         Init_Var (Var_I);
         Start_Loop_Stmt (Label);
         Gen_Exit_When
           (Label,
            New_Compare_Op (ON_Ge,
                            New_Obj_Value (Var_I),
                            New_Lit (New_Unsigned_Literal
                                       (Ghdl_Index_Type,
                                        Unsigned_64 (Info.Psl_Vect_Len))),
                            Ghdl_Bool_Type));
         New_Assign_Stmt (New_Indexed_Element (New_Obj (Var_Nvec),
                                               New_Obj_Value (Var_I)),
                          New_Lit (Std_Boolean_False_Node));
         Inc_Var (Var_I);
         Finish_Loop_Stmt (Label);
         Finish_Declare_Stmt;

         --  Global if statement for the clock.
         Open_Temp;
         Start_If_Stmt (Clk_Blk,
                        Translate_Psl_Expr (Get_PSL_Clock (Stmt), False));

         --  For each state: if set, evaluate all outgoing edges.
         NFA := Get_PSL_NFA (Stmt);
         S := Get_First_State (NFA);
         while S /= No_State loop
            S_Num := Get_State_Label (S);
            Open_Temp;

            Start_If_Stmt
              (S_Blk,
               New_Value
                 (New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
                                       New_Lit (New_Index_Lit
                                                  (Unsigned_64 (S_Num))))));

            E := Get_First_Src_Edge (S);
            while E /= No_Edge loop
               Sd := Get_Edge_Dest (E);
               Open_Temp;

               D_Lit := New_Index_Lit (Unsigned_64 (Get_State_Label (Sd)));
               Cond := New_Monadic_Op
                 (ON_Not,
                  New_Value (New_Indexed_Element (New_Obj (Var_Nvec),
                                                  New_Lit (D_Lit))));
               Cond := New_Dyadic_Op
                 (ON_And, Cond, Translate_Psl_Expr (Get_Edge_Expr (E), False));
               Start_If_Stmt (E_Blk, Cond);
               New_Assign_Stmt
                 (New_Indexed_Element (New_Obj (Var_Nvec), New_Lit (D_Lit)),
                  New_Lit (Std_Boolean_True_Node));
               Finish_If_Stmt (E_Blk);

               Close_Temp;
               E := Get_Next_Src_Edge (E);
            end loop;

            Finish_If_Stmt (S_Blk);
            Close_Temp;
            S := Get_Next_State (S);
         end loop;

         --  Check fail state.
         S := Get_Final_State (NFA);
         S_Num := Get_State_Label (S);
         pragma Assert (Integer (S_Num) = Info.Psl_Vect_Len - 1);
         Start_If_Stmt
           (S_Blk,
            New_Value
              (New_Indexed_Element (New_Obj (Var_Nvec),
                                    New_Lit (New_Index_Lit
                                               (Unsigned_64 (S_Num))))));
         case Get_Kind (Stmt) is
            when Iir_Kind_Psl_Assert_Statement =>
               Chap8.Translate_Report
                 (Stmt, Ghdl_Psl_Assert_Failed, Severity_Level_Error);
            when Iir_Kind_Psl_Cover_Statement =>
               Chap8.Translate_Report
                 (Stmt, Ghdl_Psl_Cover, Severity_Level_Note);
               New_Assign_Stmt (Get_Var (Info.Psl_Bool_Var),
                                New_Lit (Ghdl_Bool_True_Node));
            when others =>
               Error_Kind ("Translate_Psl_Directive_Statement", Stmt);
         end case;
         Finish_If_Stmt (S_Blk);

         --  Assign state vector.
         Start_Declare_Stmt;
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         Init_Var (Var_I);
         Start_Loop_Stmt (Label);
         Gen_Exit_When
           (Label,
            New_Compare_Op (ON_Ge,
                            New_Obj_Value (Var_I),
                            New_Lit (New_Unsigned_Literal
                                       (Ghdl_Index_Type,
                                        Unsigned_64 (Info.Psl_Vect_Len))),
                            Ghdl_Bool_Type));
         New_Assign_Stmt
           (New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
                                 New_Obj_Value (Var_I)),
            New_Value (New_Indexed_Element (New_Obj (Var_Nvec),
                                            New_Obj_Value (Var_I))));
         Inc_Var (Var_I);
         Finish_Loop_Stmt (Label);
         Finish_Declare_Stmt;

         Close_Temp;
         Finish_If_Stmt (Clk_Blk);

         Pop_Scope (Base.Block_Decls_Type);
         Pop_Local_Factory;
         Finish_Subprogram_Body;

         --  The finalizer.
         case Get_Kind (Stmt) is
            when Iir_Kind_Psl_Assert_Statement =>
               if Psl_Need_Finalizer (NFA) then
                  Create_Psl_Final_Proc (Stmt, Base, Instance);

                  Start_Subprogram_Body (Info.Psl_Proc_Final_Subprg);
                  Push_Local_Factory;
                  --  Push scope for architecture declarations.
                  Push_Scope (Base.Block_Decls_Type, Instance);

                  S := Get_Final_State (NFA);
                  E := Get_First_Dest_Edge (S);
                  while E /= No_Edge loop
                     Sd := Get_Edge_Src (E);

                     if PSL.NFAs.Utils.Has_EOS (Get_Edge_Expr (E)) then

                        S_Num := Get_State_Label (Sd);
                        Open_Temp;

                        Cond := New_Value
                          (New_Indexed_Element
                             (Get_Var (Info.Psl_Vect_Var),
                              New_Lit (New_Index_Lit (Unsigned_64 (S_Num)))));
                        Cond := New_Dyadic_Op
                          (ON_And, Cond,
                           Translate_Psl_Expr (Get_Edge_Expr (E), True));
                        Start_If_Stmt (E_Blk, Cond);
                        Chap8.Translate_Report
                          (Stmt, Ghdl_Psl_Assert_Failed, Severity_Level_Error);
                        New_Return_Stmt;
                        Finish_If_Stmt (E_Blk);

                        Close_Temp;
                     end if;

                     E := Get_Next_Dest_Edge (E);
                  end loop;

                  Pop_Scope (Base.Block_Decls_Type);
                  Pop_Local_Factory;
                  Finish_Subprogram_Body;
               else
                  Info.Psl_Proc_Final_Subprg := O_Dnode_Null;
               end if;

            when Iir_Kind_Psl_Cover_Statement =>
               Create_Psl_Final_Proc (Stmt, Base, Instance);

               Start_Subprogram_Body (Info.Psl_Proc_Final_Subprg);
               Push_Local_Factory;
               --  Push scope for architecture declarations.
               Push_Scope (Base.Block_Decls_Type, Instance);

               Start_If_Stmt
                 (S_Blk,
                  New_Monadic_Op (ON_Not,
                                  New_Value (Get_Var (Info.Psl_Bool_Var))));
               Chap8.Translate_Report
                 (Stmt, Ghdl_Psl_Cover_Failed, Severity_Level_Error);
               Finish_If_Stmt (S_Blk);

               Pop_Scope (Base.Block_Decls_Type);
               Pop_Local_Factory;
               Finish_Subprogram_Body;

            when others =>
               Error_Kind ("Translate_Psl_Directive_Statement(3)", Stmt);
         end case;
      end Translate_Psl_Directive_Statement;

      --  Create the instance for block BLOCK.
      --  BLOCK can be either an entity, an architecture or a block statement.
      procedure Translate_Block_Declarations (Block : Iir; Origin : Iir)
      is
         El : Iir;
      begin
         Chap4.Translate_Declaration_Chain (Block);

         El := Get_Concurrent_Statement_Chain (Block);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Process_Statement
                 | Iir_Kind_Sensitized_Process_Statement =>
                  Translate_Process_Declarations (El);
               when Iir_Kind_Psl_Default_Clock =>
                  null;
               when Iir_Kind_Psl_Declaration =>
                  null;
               when Iir_Kind_Psl_Assert_Statement
                 | Iir_Kind_Psl_Cover_Statement =>
                  Translate_Psl_Directive_Declarations (El);
               when Iir_Kind_Component_Instantiation_Statement =>
                  Translate_Component_Instantiation_Statement (El);
               when Iir_Kind_Block_Statement =>
                  declare
                     Info : Block_Info_Acc;
                     Hdr : Iir_Block_Header;
                     Guard : Iir;
                     Mark : Id_Mark_Type;
                     Field : O_Fnode;
                  begin
                     Push_Identifier_Prefix (Mark, Get_Identifier (El));

                     Info := Add_Info (El, Kind_Block);
                     Chap1.Start_Block_Decl (El);
                     Push_Instance_Factory (Info.Block_Decls_Type);

                     Guard := Get_Guard_Decl (El);
                     if Guard /= Null_Iir then
                        Chap4.Translate_Declaration (Guard);
                     end if;

                     --  generics, ports.
                     Hdr := Get_Block_Header (El);
                     if Hdr /= Null_Iir then
                        Chap4.Translate_Generic_Chain (Hdr);
                        Chap4.Translate_Port_Chain (Hdr);
                     end if;

                     Chap9.Translate_Block_Declarations (El, Origin);

                     Pop_Instance_Factory (Info.Block_Decls_Type);
                     Pop_Identifier_Prefix (Mark);

                     --  Create a field in the parent record.
                     Field := Add_Instance_Factory_Field
                       (Create_Identifier_Without_Prefix (El),
                        Info.Block_Decls_Type);
                     --  Set info in child record.
                     Info.Block_Parent_Field := Field;
                  end;
               when Iir_Kind_Generate_Statement =>
                  declare
                     Info : Block_Info_Acc;
                     Mark : Id_Mark_Type;
                     Scheme : Iir;
                     Iter_Type : Iir;
                     It_Info : Ortho_Info_Acc;
                  begin
                     Scheme := Get_Generation_Scheme (El);

                     Push_Identifier_Prefix (Mark, Get_Identifier (El));

                     if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
                        Iter_Type := Get_Type (Scheme);
                        Chap3.Translate_Object_Subtype (Scheme, True);
                     end if;

                     Info := Add_Info (El, Kind_Block);
                     Chap1.Start_Block_Decl (El);
                     Push_Instance_Factory (Info.Block_Decls_Type);

                     --  Add a parent field in the current instance.
                     Info.Block_Origin_Field := Add_Instance_Factory_Field
                       (Get_Identifier ("ORIGIN"),
                        Get_Info (Origin).Block_Decls_Ptr_Type);

                     --  Iterator.
                     if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
                        Info.Block_Configured_Field :=
                          Add_Instance_Factory_Field
                          (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type);
                        It_Info := Add_Info (Scheme, Kind_Iterator);
                        It_Info.Iterator_Var := Create_Var
                          (Create_Var_Identifier (Scheme),
                           Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type
                           (Mode_Value));
                     end if;

                     Chap9.Translate_Block_Declarations (El, El);

                     Pop_Instance_Factory (Info.Block_Decls_Type);

                     if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
                        --  Create array type of block_decls_type
                        Info.Block_Decls_Array_Type := New_Array_Type
                          (Info.Block_Decls_Type, Ghdl_Index_Type);
                        New_Type_Decl (Create_Identifier ("INSTARRTYPE"),
                                       Info.Block_Decls_Array_Type);
                        --  Create access to the array type.
                        Info.Block_Decls_Array_Ptr_Type := New_Access_Type
                          (Info.Block_Decls_Array_Type);
                        New_Type_Decl (Create_Identifier ("INSTARRPTR"),
                                       Info.Block_Decls_Array_Ptr_Type);
                        --  Add a field in parent record
                        Info.Block_Parent_Field := Add_Instance_Factory_Field
                          (Create_Identifier_Without_Prefix (El),
                           Info.Block_Decls_Array_Ptr_Type);
                     else
                        --  Create an access field in the parent record.
                        Info.Block_Parent_Field := Add_Instance_Factory_Field
                          (Create_Identifier_Without_Prefix (El),
                           Info.Block_Decls_Ptr_Type);
                     end if;

                     Pop_Identifier_Prefix (Mark);
                  end;
               when others =>
                  Error_Kind ("translate_block_declarations", El);
            end case;
            El := Get_Chain (El);
         end loop;
      end Translate_Block_Declarations;

      procedure Translate_Component_Instantiation_Subprogram
        (Stmt : Iir; Base : Block_Info_Acc)
      is
         procedure Set_Component_Link (Ref_Type : O_Tnode;
                                       Comp_Field : O_Fnode)
         is
         begin
            New_Assign_Stmt
              (New_Selected_Element
               (New_Selected_Element (Get_Instance_Ref (Ref_Type), Comp_Field),
                Rtis.Ghdl_Component_Link_Stmt),
               New_Lit (Rtis.Get_Context_Rti (Stmt)));
         end Set_Component_Link;

         Info : Block_Info_Acc;

         Comp : Iir;
         Comp_Info : Comp_Info_Acc;
         Parent_Info : Block_Info_Acc;
         Inter_List : O_Inter_List;
         Instance : O_Dnode;
      begin
         --  Create the elaborator for the instantiation.
         Info := Get_Info (Stmt);
         Start_Procedure_Decl (Inter_List, Create_Identifier ("ELAB"),
                               O_Storage_Private);
         New_Interface_Decl (Inter_List, Instance, Wki_Instance,
                             Base.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Info.Block_Elab_Subprg);

         Start_Subprogram_Body (Info.Block_Elab_Subprg);
         Push_Local_Factory;
         Push_Scope (Base.Block_Decls_Type, Instance);

         New_Debug_Line_Stmt (Get_Line_Number (Stmt));

         Parent_Info := Get_Info (Get_Parent (Stmt));

         --  Add access to the instantiation-specific data.
         --  This is used only for anonymous subtype variables.
         if Info.Block_Decls_Type /= O_Tnode_Null then
            Push_Scope (Info.Block_Decls_Type,
                        Info.Block_Parent_Field,
                        Parent_Info.Block_Decls_Type);
         end if;

         Comp := Get_Instantiated_Unit (Stmt);
         if Get_Kind (Comp) not in Iir_Kinds_Denoting_Name then
            --  This is a direct instantiation.
            Set_Component_Link (Parent_Info.Block_Decls_Type,
                                Info.Block_Link_Field);
            Translate_Entity_Instantiation (Comp, Stmt, Stmt, Null_Iir);
         else
            Comp := Get_Named_Entity (Comp);
            Comp_Info := Get_Info (Comp);
            Push_Scope (Comp_Info.Comp_Type, Info.Block_Link_Field,
                        Parent_Info.Block_Decls_Type);

            --  Set the link from component declaration to component
            --  instantiation statement.
            Set_Component_Link (Comp_Info.Comp_Type, Comp_Info.Comp_Link);

            Chap5.Elab_Map_Aspect (Stmt, Comp);

            Pop_Scope (Comp_Info.Comp_Type);
         end if;

         if Info.Block_Decls_Type /= O_Tnode_Null then
            Pop_Scope (Info.Block_Decls_Type);
         end if;

         Pop_Scope (Base.Block_Decls_Type);
         Pop_Local_Factory;
         Finish_Subprogram_Body;
      end Translate_Component_Instantiation_Subprogram;

      --  Translate concurrent statements into subprograms.
      procedure Translate_Block_Subprograms (Block : Iir; Base_Block : Iir)
      is
         Stmt : Iir;
         Mark : Id_Mark_Type;
         Block_Info : Block_Info_Acc;
         Base_Info : Block_Info_Acc;
      begin
         Base_Info := Get_Info (Base_Block);

         Chap4.Translate_Declaration_Chain_Subprograms (Block, Base_Block);

         Block_Info := Get_Info (Block);
         Stmt := Get_Concurrent_Statement_Chain (Block);
         while Stmt /= Null_Iir loop
            Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
            case Get_Kind (Stmt) is
               when Iir_Kind_Process_Statement
                 | Iir_Kind_Sensitized_Process_Statement =>
                  declare
                     Info : Proc_Info_Acc;
                  begin
                     Info := Get_Info (Stmt);
                     Push_Scope (Info.Process_Decls_Type,
                                 Info.Process_Parent_Field,
                                 Block_Info.Block_Decls_Type);
                     if Flag_Direct_Drivers then
                        Chap9.Set_Direct_Drivers (Stmt);
                     end if;

                     Chap4.Translate_Declaration_Chain_Subprograms
                       (Stmt, Base_Block);
                     Translate_Process_Statement (Stmt, Base_Info);

                     if Flag_Direct_Drivers then
                        Chap9.Reset_Direct_Drivers (Stmt);
                     end if;
                     Pop_Scope (Info.Process_Decls_Type);
                  end;
               when Iir_Kind_Psl_Default_Clock =>
                  null;
               when Iir_Kind_Psl_Declaration =>
                  null;
               when Iir_Kind_Psl_Assert_Statement
                 | Iir_Kind_Psl_Cover_Statement =>
                  declare
                     Info : Psl_Info_Acc;
                  begin
                     Info := Get_Info (Stmt);
                     Push_Scope (Info.Psl_Decls_Type,
                                 Info.Psl_Parent_Field,
                                 Block_Info.Block_Decls_Type);
                     Translate_Psl_Directive_Statement (Stmt, Base_Info);
                     Pop_Scope (Info.Psl_Decls_Type);
                  end;
               when Iir_Kind_Component_Instantiation_Statement =>
                  Chap4.Translate_Association_Subprograms
                    (Stmt, Block, Base_Block,
                     Get_Entity_From_Entity_Aspect
                     (Get_Instantiated_Unit (Stmt)));
                  Translate_Component_Instantiation_Subprogram
                    (Stmt, Base_Info);
               when Iir_Kind_Block_Statement =>
                  declare
                     Info : Block_Info_Acc;
                     Guard : Iir;
                     Hdr : Iir;
                  begin
                     Info := Get_Info (Stmt);
                     Push_Scope (Info.Block_Decls_Type,
                                 Info.Block_Parent_Field,
                                 Block_Info.Block_Decls_Type);
                     Guard := Get_Guard_Decl (Stmt);
                     if Guard /= Null_Iir then
                        Translate_Implicit_Guard_Signal (Guard, Base_Info);
                     end if;
                     Hdr := Get_Block_Header (Stmt);
                     if Hdr /= Null_Iir then
                        Chap4.Translate_Association_Subprograms
                          (Hdr, Block, Base_Block, Null_Iir);
                     end if;
                     Translate_Block_Subprograms (Stmt, Base_Block);
                     Pop_Scope (Info.Block_Decls_Type);
                  end;
               when Iir_Kind_Generate_Statement =>
                  declare
                     Info : Block_Info_Acc;
                     Prev_Subprg_Instance : Chap2.Subprg_Instance_Stack;
                  begin
                     Info := Get_Info (Stmt);
                     Chap2.Push_Subprg_Instance (Info.Block_Decls_Type,
                                                 Info.Block_Decls_Ptr_Type,
                                                 Wki_Instance,
                                                 Prev_Subprg_Instance);
                     Push_Scope_Via_Field_Ptr (Base_Info.Block_Decls_Type,
                                               Info.Block_Origin_Field,
                                               Info.Block_Decls_Type);
                     Translate_Block_Subprograms (Stmt, Stmt);
                     Pop_Scope (Base_Info.Block_Decls_Type);
                     Chap2.Pop_Subprg_Instance
                       (Wki_Instance, Prev_Subprg_Instance);
                  end;
               when others =>
                  Error_Kind ("translate_block_subprograms", Stmt);
            end case;
            Pop_Identifier_Prefix (Mark);
            Stmt := Get_Chain (Stmt);
         end loop;
      end Translate_Block_Subprograms;

      --  Remove anonymous and implicit type definitions in a list of names.
      --  Such type definitions are created during slice translations, however
      --  variables created are defined in the translation scope.
      --  If the type is referenced again, the variables must be reachable.
      --  This is not the case for elaborator subprogram (which may references
      --  slices in the sensitivity or driver list) and the process subprg.
      procedure Destroy_Types_In_Name (Name : Iir)
      is
         El : Iir;
         Atype : Iir;
         Info : Type_Info_Acc;
      begin
         El := Name;
         loop
            Atype := Null_Iir;
            case Get_Kind (El) is
               when Iir_Kind_Selected_Element
                 | Iir_Kind_Indexed_Name =>
                  El := Get_Prefix (El);
               when Iir_Kind_Slice_Name =>
                  Atype := Get_Type (El);
                  El := Get_Prefix (El);
               when Iir_Kind_Object_Alias_Declaration =>
                  El := Get_Name (El);
               when Iir_Kind_Stable_Attribute
                 | Iir_Kind_Quiet_Attribute
                 | Iir_Kind_Delayed_Attribute
                 | Iir_Kind_Transaction_Attribute =>
                  El := Get_Prefix (El);
               when Iir_Kind_Signal_Declaration
                 | Iir_Kind_Signal_Interface_Declaration
                 | Iir_Kind_Guard_Signal_Declaration =>
                  exit;
               when Iir_Kinds_Denoting_Name =>
                  El := Get_Named_Entity (El);
               when others =>
                  Error_Kind ("destroy_types_in_name", El);
            end case;
            if Atype /= Null_Iir
              and then Is_Anonymous_Type_Definition (Atype)
            then
               Info := Get_Info (Atype);
               if Info /= null then
                  Free_Type_Info (Info, False);
                  Clear_Info (Atype);
               end if;
            end if;
         end loop;
      end Destroy_Types_In_Name;

      procedure Destroy_Types_In_List (List : Iir_List)
      is
         El : Iir;
      begin
         if List = Null_Iir_List then
            return;
         end if;
         for I in Natural loop
            El := Get_Nth_Element (List, I);
            exit when El = Null_Iir;
            Destroy_Types_In_Name (El);
         end loop;
      end Destroy_Types_In_List;

      procedure Gen_Register_Direct_Driver_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Drv : Mnode)
      is
         pragma Unreferenced (Targ_Type);
         Constr : O_Assoc_List;
      begin
         Start_Association (Constr, Ghdl_Signal_Add_Direct_Driver);
         New_Association
           (Constr, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr));
         New_Association
           (Constr, New_Unchecked_Address (M2Lv (Drv), Ghdl_Ptr_Type));
         New_Procedure_Call (Constr);
      end Gen_Register_Direct_Driver_Non_Composite;

      function Gen_Register_Direct_Driver_Prepare_Data_Composite
        (Targ : Mnode; Targ_Type : Iir; Val : Mnode)
        return Mnode
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Val;
      end Gen_Register_Direct_Driver_Prepare_Data_Composite;

      function Gen_Register_Direct_Driver_Prepare_Data_Record
        (Targ : Mnode; Targ_Type : Iir; Val : Mnode)
        return Mnode
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Stabilize (Val);
      end Gen_Register_Direct_Driver_Prepare_Data_Record;

      function Gen_Register_Direct_Driver_Update_Data_Array
        (Val : Mnode; Targ_Type : Iir; Index : O_Dnode)
        return Mnode
      is
      begin
         return Chap3.Index_Base (Chap3.Get_Array_Base (Val),
                                  Targ_Type, New_Obj_Value (Index));
      end Gen_Register_Direct_Driver_Update_Data_Array;

      function Gen_Register_Direct_Driver_Update_Data_Record
        (Val : Mnode; Targ_Type : Iir; El : Iir_Element_Declaration)
        return Mnode
      is
         pragma Unreferenced (Targ_Type);
      begin
         return Chap6.Translate_Selected_Element (Val, El);
      end Gen_Register_Direct_Driver_Update_Data_Record;

      procedure Gen_Register_Direct_Driver_Finish_Data_Composite
        (Data : in out Mnode)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Gen_Register_Direct_Driver_Finish_Data_Composite;

      procedure Gen_Register_Direct_Driver is new Foreach_Non_Composite
        (Data_Type => Mnode,
         Composite_Data_Type => Mnode,
         Do_Non_Composite => Gen_Register_Direct_Driver_Non_Composite,
         Prepare_Data_Array =>
           Gen_Register_Direct_Driver_Prepare_Data_Composite,
         Update_Data_Array => Gen_Register_Direct_Driver_Update_Data_Array,
         Finish_Data_Array => Gen_Register_Direct_Driver_Finish_Data_Composite,
         Prepare_Data_Record => Gen_Register_Direct_Driver_Prepare_Data_Record,
         Update_Data_Record => Gen_Register_Direct_Driver_Update_Data_Record,
         Finish_Data_Record =>
           Gen_Register_Direct_Driver_Finish_Data_Composite);

--        procedure Register_Scalar_Direct_Driver (Sig : Mnode;
--                                                 Sig_Type : Iir;
--                                                 Drv : Mnode)
--        is
--           pragma Unreferenced (Sig_Type);
--           Constr : O_Assoc_List;
--        begin
--           Start_Association (Constr, Ghdl_Signal_Add_Direct_Driver);
--           New_Association
--          (Constr, New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
--           New_Association
--             (Constr, New_Unchecked_Address (M2Lv (Drv), Ghdl_Ptr_Type));
--           New_Procedure_Call (Constr);
--        end Register_Scalar_Direct_Driver;


      --  PROC: the process to be elaborated
      --  BLOCK_INFO: info for the block containing the process
      --  BASE_INFO: info for the global block
      procedure Elab_Process (Proc : Iir;
                              Block_Info : Block_Info_Acc;
                              Base_Info : Block_Info_Acc)
      is
         Is_Sensitized : Boolean;
         Subprg : O_Dnode;
         Constr : O_Assoc_List;
         Info : Proc_Info_Acc;
         List : Iir_List;
         List_Orig : Iir_List;
         Final : Boolean;
      begin
         New_Debug_Line_Stmt (Get_Line_Number (Proc));

         Is_Sensitized :=
           Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement;
         Info := Get_Info (Proc);

         --  Set instance name.
         Push_Scope (Info.Process_Decls_Type,
                     Info.Process_Parent_Field,
                     Block_Info.Block_Decls_Type);

         --  Register process.
         if Is_Sensitized then
            if Get_Postponed_Flag (Proc) then
               Subprg := Ghdl_Postponed_Sensitized_Process_Register;
            else
               Subprg := Ghdl_Sensitized_Process_Register;
            end if;
         else
            if Get_Postponed_Flag (Proc) then
               Subprg := Ghdl_Postponed_Process_Register;
            else
               Subprg := Ghdl_Process_Register;
            end if;
         end if;

         Start_Association (Constr, Subprg);
         New_Association
           (Constr, New_Unchecked_Address
            (Get_Instance_Ref (Base_Info.Block_Decls_Type), Ghdl_Ptr_Type));
         New_Association
           (Constr,
            New_Lit (New_Subprogram_Address (Info.Process_Subprg,
                                             Ghdl_Ptr_Type)));
         Rtis.Associate_Rti_Context (Constr, Proc);
         New_Procedure_Call (Constr);

         --  First elaborate declarations since a driver may depend on
         --  an alias declaration.
         --  Also, with vhdl 08 a sensitivity element may depend on an alias.
         Open_Temp;
         Chap4.Elab_Declaration_Chain (Proc, Final);
         Close_Temp;

         --  Register drivers.
         if Flag_Direct_Drivers then
            Chap9.Set_Direct_Drivers (Proc);

            declare
               Sig : Iir;
               Base : Iir;
               Sig_Node, Drv_Node : Mnode;
            begin
               for I in Info.Process_Drivers.all'Range loop
                  Sig := Info.Process_Drivers (I).Sig;
                  Open_Temp;
                  Base := Get_Object_Prefix (Sig);
                  if Info.Process_Drivers (I).Var /= null then
                     --  Elaborate direct driver.  Done only once.
                     Chap4.Elab_Direct_Driver_Declaration_Storage (Base);
                  end if;
                  if Chap4.Has_Direct_Driver (Base) then
                     --  Signal has a direct driver.
                     Chap6.Translate_Direct_Driver (Sig, Sig_Node, Drv_Node);
                     Gen_Register_Direct_Driver
                       (Sig_Node, Get_Type (Sig), Drv_Node);
                  else
                     Register_Signal (Chap6.Translate_Name (Sig),
                                      Get_Type (Sig),
                                      Ghdl_Process_Add_Driver);
                  end if;
                  Close_Temp;
               end loop;
            end;

            Chap9.Reset_Direct_Drivers (Proc);
         else
            List := Trans_Analyzes.Extract_Drivers (Proc);
            Destroy_Types_In_List (List);
            Register_Signal_List (List, Ghdl_Process_Add_Driver);
            if Flag_Dump_Drivers then
               Trans_Analyzes.Dump_Drivers (Proc, List);
            end if;
            Trans_Analyzes.Free_Drivers_List (List);
         end if;

         if Is_Sensitized then
            List_Orig := Get_Sensitivity_List (Proc);
            if List_Orig = Iir_List_All then
               List := Canon.Canon_Extract_Process_Sensitivity (Proc);
            else
               List := List_Orig;
            end if;
            Destroy_Types_In_List (List);
            Register_Signal_List (List, Ghdl_Process_Add_Sensitivity);
            if List_Orig = Iir_List_All then
               Destroy_Iir_List (List);
            end if;
         end if;

         Pop_Scope (Info.Process_Decls_Type);
      end Elab_Process;

      --  PROC: the process to be elaborated
      --  BLOCK_INFO: info for the block containing the process
      --  BASE_INFO: info for the global block
      procedure Elab_Psl_Directive (Stmt : Iir;
                                    Block_Info : Block_Info_Acc;
                                    Base_Info : Block_Info_Acc)
      is
         Constr : O_Assoc_List;
         Info : Psl_Info_Acc;
         List : Iir_List;
         Clk : PSL_Node;
         Var_I : O_Dnode;
         Label : O_Snode;
      begin
         New_Debug_Line_Stmt (Get_Line_Number (Stmt));

         Info := Get_Info (Stmt);

         --  Set instance name.
         Push_Scope (Info.Psl_Decls_Type,
                     Info.Psl_Parent_Field,
                     Block_Info.Block_Decls_Type);

         --  Register process.
         Start_Association (Constr, Ghdl_Sensitized_Process_Register);
         New_Association
           (Constr, New_Unchecked_Address
            (Get_Instance_Ref (Base_Info.Block_Decls_Type), Ghdl_Ptr_Type));
         New_Association
           (Constr,
            New_Lit (New_Subprogram_Address (Info.Psl_Proc_Subprg,
                                             Ghdl_Ptr_Type)));
         Rtis.Associate_Rti_Context (Constr, Stmt);
         New_Procedure_Call (Constr);

         --  Register clock sensitivity.
         Clk := Get_PSL_Clock (Stmt);
         List := Create_Iir_List;
         Canon_PSL.Canon_Extract_Sensitivity (Clk, List);
         Destroy_Types_In_List (List);
         Register_Signal_List (List, Ghdl_Process_Add_Sensitivity);
         Destroy_Iir_List (List);

         --  Register finalizer (if any).
         if Info.Psl_Proc_Final_Subprg /= O_Dnode_Null then
            Start_Association (Constr, Ghdl_Finalize_Register);
            New_Association
              (Constr, New_Unchecked_Address
                 (Get_Instance_Ref (Base_Info.Block_Decls_Type),
                  Ghdl_Ptr_Type));
            New_Association
              (Constr,
               New_Lit (New_Subprogram_Address (Info.Psl_Proc_Final_Subprg,
                                                Ghdl_Ptr_Type)));
            New_Procedure_Call (Constr);
         end if;

         --  Initialize state vector.
         Start_Declare_Stmt;
         New_Var_Decl (Var_I, Wki_I, O_Storage_Local, Ghdl_Index_Type);
         New_Assign_Stmt (New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
                                               New_Lit (Ghdl_Index_0)),
                          New_Lit (Std_Boolean_True_Node));
         New_Assign_Stmt (New_Obj (Var_I), New_Lit (Ghdl_Index_1));
         Start_Loop_Stmt (Label);
         Gen_Exit_When
           (Label,
            New_Compare_Op (ON_Ge,
                            New_Obj_Value (Var_I),
                            New_Lit (New_Unsigned_Literal
                                       (Ghdl_Index_Type,
                                        Unsigned_64 (Info.Psl_Vect_Len))),
                            Ghdl_Bool_Type));
         New_Assign_Stmt (New_Indexed_Element (Get_Var (Info.Psl_Vect_Var),
                                               New_Obj_Value (Var_I)),
                          New_Lit (Std_Boolean_False_Node));
         Inc_Var (Var_I);
         Finish_Loop_Stmt (Label);
         Finish_Declare_Stmt;

         if Info.Psl_Bool_Var /= null then
            New_Assign_Stmt (Get_Var (Info.Psl_Bool_Var),
                             New_Lit (Ghdl_Bool_False_Node));
         end if;

         Pop_Scope (Info.Psl_Decls_Type);
      end Elab_Psl_Directive;

      procedure Elab_Implicit_Guard_Signal
        (Block : Iir_Block_Statement; Block_Info : Block_Info_Acc)
      is
         Guard : Iir;
         Type_Info : Type_Info_Acc;
         Info : Object_Info_Acc;
         Constr : O_Assoc_List;
      begin
         --  Create the guard signal.
         Guard := Get_Guard_Decl (Block);
         Info := Get_Info (Guard);
         Type_Info := Get_Info (Get_Type (Guard));
         Start_Association (Constr, Ghdl_Signal_Create_Guard);
         New_Association
           (Constr, New_Unchecked_Address
            (Get_Instance_Ref (Block_Info.Block_Decls_Type), Ghdl_Ptr_Type));
         New_Association
           (Constr,
            New_Lit (New_Subprogram_Address (Info.Object_Function,
                                             Ghdl_Ptr_Type)));
--         New_Association (Constr, Chap6.Get_Instance_Name_Ref (Block));
         New_Assign_Stmt (Get_Var (Info.Object_Var),
                          New_Convert_Ov (New_Function_Call (Constr),
                                          Type_Info.Ortho_Type (Mode_Signal)));

         --  Register sensitivity list of the guard signal.
         Register_Signal_List (Get_Guard_Sensitivity_List (Guard),
                               Ghdl_Signal_Guard_Dependence);
      end Elab_Implicit_Guard_Signal;

      procedure Translate_Entity_Instantiation
        (Aspect : Iir; Mapping : Iir; Parent : Iir; Config_Override : Iir)
      is
         Entity_Unit : Iir_Design_Unit;
         Config : Iir;
         Arch : Iir;
         Entity : Iir_Entity_Declaration;
         Entity_Info : Block_Info_Acc;
         Arch_Info : Block_Info_Acc;

         Instance_Size : O_Dnode;
         Arch_Elab : O_Dnode;
         Arch_Config : O_Dnode;
         Arch_Config_Type : O_Tnode;

         Var_Sub : O_Dnode;
      begin
         --  Extract entity, architecture and configuration from
         --  binding aspect.
         case Get_Kind (Aspect) is
            when Iir_Kind_Entity_Aspect_Entity =>
               Entity := Get_Entity (Aspect);
               Arch := Get_Architecture (Aspect);
               if Flags.Flag_Elaborate and then Arch = Null_Iir then
                  --  This is valid only during elaboration.
                  Arch := Libraries.Get_Latest_Architecture (Entity);
               end if;
               Config := Null_Iir;
            when Iir_Kind_Entity_Aspect_Configuration =>
               Config := Get_Configuration (Aspect);
               Entity := Get_Entity (Config);
               Arch := Get_Block_Specification
                 (Get_Block_Configuration (Config));
            when Iir_Kind_Entity_Aspect_Open =>
               return;
            when others =>
               Error_Kind ("translate_entity_instantiation", Aspect);
         end case;
         Entity_Unit := Get_Design_Unit (Entity);
         Entity_Info := Get_Info (Entity);
         if Config_Override /= Null_Iir then
            Config := Config_Override;
            if Get_Kind (Arch) = Iir_Kind_Simple_Name then
               Arch := Get_Block_Specification
                 (Get_Block_Configuration (Config));
            end if;
         end if;

         --  1) Create instance for the arch
         if Arch /= Null_Iir then
            Arch_Info := Get_Info (Arch);
            if Config = Null_Iir
              and then Get_Kind (Arch) = Iir_Kind_Architecture_Body
            then
               Config := Get_Default_Configuration_Declaration (Arch);
               if Config /= Null_Iir then
                  Config := Get_Library_Unit (Config);
               end if;
            end if;
         else
            Arch_Info := null;
         end if;
         if Arch_Info = null or Config = Null_Iir then
            declare
               function Get_Arch_Name return String is
               begin
                  if Arch /= Null_Iir then
                     return "ARCH__" & Image_Identifier (Arch);
                  else
                     return "LASTARCH";
                  end if;
               end Get_Arch_Name;

               Str : constant String :=
                 Image_Identifier (Get_Library (Get_Design_File (Entity_Unit)))
                 & "__" & Image_Identifier (Entity) & "__"
                 & Get_Arch_Name & "__";
               Sub_Inter : O_Inter_List;
               Arg : O_Dnode;
            begin
               if Arch_Info = null then
                  New_Const_Decl
                    (Instance_Size, Get_Identifier (Str & "INSTSIZE"),
                     O_Storage_External, Ghdl_Index_Type);

                  Start_Procedure_Decl
                    (Sub_Inter, Get_Identifier (Str & "ELAB"),
                     O_Storage_External);
                  New_Interface_Decl (Sub_Inter, Arg, Wki_Instance,
                                      Entity_Info.Block_Decls_Ptr_Type);
                  Finish_Subprogram_Decl (Sub_Inter, Arch_Elab);
               end if;

               if Config = Null_Iir then
                  Start_Procedure_Decl
                    (Sub_Inter, Get_Identifier (Str & "DEFAULT_CONFIG"),
                     O_Storage_External);
                  New_Interface_Decl (Sub_Inter, Arg, Wki_Instance,
                                      Entity_Info.Block_Decls_Ptr_Type);
                  Finish_Subprogram_Decl (Sub_Inter, Arch_Config);

                  Arch_Config_Type := Entity_Info.Block_Decls_Ptr_Type;
               end if;
            end;
         end if;

         if Arch_Info = null then
            if Config /= Null_Iir then
               --  Architecture is unknown, but we know how to configure
               --  the block inside it.
               raise Internal_Error;
            end if;
         else
            Instance_Size := Arch_Info.Block_Instance_Size;
            Arch_Elab := Arch_Info.Block_Elab_Subprg;
            if Config /= Null_Iir then
               Arch_Config := Get_Info (Config).Config_Subprg;
               Arch_Config_Type := Arch_Info.Block_Decls_Ptr_Type;
            end if;
         end if;

         --  Create the instance variable and allocate storage.
         New_Var_Decl (Var_Sub, Get_Identifier ("SUB_INSTANCE"),
                       O_Storage_Local, Entity_Info.Block_Decls_Ptr_Type);

         New_Assign_Stmt
           (New_Obj (Var_Sub),
            Gen_Alloc (Alloc_System, New_Obj_Value (Instance_Size),
                       Entity_Info.Block_Decls_Ptr_Type));

         --  1.5) link instance.
         declare
            procedure Set_Links (Ref_Type : O_Tnode; Link_Field : O_Fnode)
            is
            begin
               --  Set the ghdl_component_link_instance field.
               New_Assign_Stmt
                 (New_Selected_Element
                  (New_Selected_Element (Get_Instance_Ref (Ref_Type),
                                         Link_Field),
                   Rtis.Ghdl_Component_Link_Instance),
                  New_Address (New_Selected_Acc_Value
                               (New_Obj (Var_Sub),
                                Entity_Info.Block_Link_Field),
                               Rtis.Ghdl_Entity_Link_Acc));
               --  Set the ghdl_entity_link_parent field.
               New_Assign_Stmt
                 (New_Selected_Element
                  (New_Selected_Acc_Value (New_Obj (Var_Sub),
                                           Entity_Info.Block_Link_Field),
                   Rtis.Ghdl_Entity_Link_Parent),
                  New_Address
                  (New_Selected_Element (Get_Instance_Ref (Ref_Type),
                                         Link_Field),
                   Rtis.Ghdl_Component_Link_Acc));
            end Set_Links;
         begin
            case Get_Kind (Parent) is
               when Iir_Kind_Component_Declaration =>
                  --  Instantiation via a component declaration.
                  declare
                     Comp_Info : Comp_Info_Acc;
                  begin
                     Comp_Info := Get_Info (Parent);
                     Set_Links (Comp_Info.Comp_Type, Comp_Info.Comp_Link);
                  end;
               when Iir_Kind_Component_Instantiation_Statement =>
                  --  Direct instantiation.
                  declare
                     Parent_Info : Block_Info_Acc;
                  begin
                     Parent_Info := Get_Info (Get_Parent (Parent));
                     Set_Links (Parent_Info.Block_Decls_Type,
                                Get_Info (Parent).Block_Link_Field);
                  end;
               when others =>
                  Error_Kind ("translate_entity_instantiation(1)", Parent);
            end case;
         end;

         --  Elab entity packages.
         declare
            Assoc : O_Assoc_List;
         begin
            Start_Association (Assoc, Entity_Info.Block_Elab_Pkg_Subprg);
            New_Procedure_Call (Assoc);
         end;

         --  Elab map aspects.
         Push_Scope (Entity_Info.Block_Decls_Type, Var_Sub);
         Chap5.Elab_Map_Aspect (Mapping, Entity);
         Pop_Scope (Entity_Info.Block_Decls_Type);

         --  3) Elab instance.
         declare
            Assoc : O_Assoc_List;
         begin
            Start_Association (Assoc, Arch_Elab);
            New_Association (Assoc, New_Obj_Value (Var_Sub));
            New_Procedure_Call (Assoc);
         end;

         --  5) Configure
         declare
            Assoc : O_Assoc_List;
         begin
            Start_Association (Assoc, Arch_Config);
            New_Association (Assoc, New_Convert_Ov (New_Obj_Value (Var_Sub),
                                                    Arch_Config_Type));
            New_Procedure_Call (Assoc);
         end;
      end Translate_Entity_Instantiation;

      procedure Elab_Conditionnal_Generate_Statement
        (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
      is
         Scheme : Iir;
         Info : Block_Info_Acc;
         Var : O_Dnode;
         Blk : O_If_Block;
         V : O_Lnode;
         Parent_Info : Block_Info_Acc;
         Base_Info : Block_Info_Acc;
      begin
         Parent_Info := Get_Info (Parent);
         Base_Info := Get_Info (Base_Block);
         Scheme := Get_Generation_Scheme (Stmt);
         Info := Get_Info (Stmt);
         Open_Temp;

         Var := Create_Temp (Info.Block_Decls_Ptr_Type);
         Start_If_Stmt (Blk, Chap7.Translate_Expression (Scheme));
         New_Assign_Stmt
           (New_Obj (Var),
            Gen_Alloc (Alloc_System,
                       New_Lit (New_Sizeof (Info.Block_Decls_Type,
                                            Ghdl_Index_Type)),
                       Info.Block_Decls_Ptr_Type));
         New_Else_Stmt (Blk);
         New_Assign_Stmt
           (New_Obj (Var),
            New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)));
         Finish_If_Stmt (Blk);

         --  Add a link to child in parent.
         V := Get_Instance_Ref (Parent_Info.Block_Decls_Type);
         V := New_Selected_Element (V, Info.Block_Parent_Field);
         New_Assign_Stmt (V, New_Obj_Value (Var));

         Start_If_Stmt
           (Blk,
            New_Compare_Op
            (ON_Neq,
             New_Obj_Value (Var),
             New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)),
             Ghdl_Bool_Type));
         --  Add a link to parent in child.
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field),
            Get_Instance_Access (Base_Block));
         --  Elaborate block
         Push_Scope (Info.Block_Decls_Type, Var);
         Push_Scope_Via_Field_Ptr (Base_Info.Block_Decls_Type,
                                   Info.Block_Origin_Field,
                                   Info.Block_Decls_Type);
         Elab_Block_Declarations (Stmt, Stmt);
         Pop_Scope (Base_Info.Block_Decls_Type);
         Pop_Scope (Info.Block_Decls_Type);
         Finish_If_Stmt (Blk);
         Close_Temp;
      end Elab_Conditionnal_Generate_Statement;

      procedure Elab_Iterative_Generate_Statement
        (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir)
      is
         Scheme : Iir;
         Iter_Type : Iir;
         Iter_Base_Type : Iir;
         Iter_Type_Info : Type_Info_Acc;
         Info : Block_Info_Acc;
         Var_Inst : O_Dnode;
         Var_I : O_Dnode;
         Label : O_Snode;
         V : O_Lnode;
         Var : O_Dnode;
         Parent_Info : Block_Info_Acc;
         Base_Info : Block_Info_Acc;
         Range_Ptr : O_Dnode;
      begin
         Parent_Info := Get_Info (Parent);
         Base_Info := Get_Info (Base_Block);

         Scheme := Get_Generation_Scheme (Stmt);
         Iter_Type := Get_Type (Scheme);
         Iter_Base_Type := Get_Base_Type (Iter_Type);
         Iter_Type_Info := Get_Info (Iter_Base_Type);
         Info := Get_Info (Stmt);

         Open_Temp;

         --  Evaluate iterator range.
         Chap3.Elab_Object_Subtype (Iter_Type);

         Range_Ptr := Create_Temp_Ptr
           (Iter_Type_Info.T.Range_Ptr_Type,
            Get_Var (Get_Info (Iter_Type).T.Range_Var));

         --  Allocate instances.
         Var_Inst := Create_Temp (Info.Block_Decls_Array_Ptr_Type);
         New_Assign_Stmt
           (New_Obj (Var_Inst),
            Gen_Alloc
            (Alloc_System,
             New_Dyadic_Op (ON_Mul_Ov,
                            New_Value_Selected_Acc_Value
                            (New_Obj (Range_Ptr),
                             Iter_Type_Info.T.Range_Length),
                            New_Lit (New_Sizeof (Info.Block_Decls_Type,
                                                 Ghdl_Index_Type))),
             Info.Block_Decls_Array_Ptr_Type));

         --  Add a link to child in parent.
         V := Get_Instance_Ref (Parent_Info.Block_Decls_Type);
         V := New_Selected_Element (V, Info.Block_Parent_Field);
         New_Assign_Stmt (V, New_Obj_Value (Var_Inst));

         --  Start loop.
         Var_I := Create_Temp (Ghdl_Index_Type);
         Init_Var (Var_I);
         Start_Loop_Stmt (Label);
         Gen_Exit_When
           (Label,
            New_Compare_Op (ON_Eq,
                            New_Obj_Value (Var_I),
                            New_Value_Selected_Acc_Value
                            (New_Obj (Range_Ptr),
                             Iter_Type_Info.T.Range_Length),
                            Ghdl_Bool_Type));

         Var := Create_Temp_Ptr
           (Info.Block_Decls_Ptr_Type,
            New_Indexed_Element (New_Acc_Value (New_Obj (Var_Inst)),
                                 New_Obj_Value (Var_I)));
         --  Add a link to parent in child.
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field),
            Get_Instance_Access (Base_Block));
         --  Mark the block as not (yet) configured.
         New_Assign_Stmt
           (New_Selected_Acc_Value (New_Obj (Var),
                                    Info.Block_Configured_Field),
            New_Lit (Ghdl_Bool_False_Node));

         --  Elaborate block
         Push_Scope (Info.Block_Decls_Type, Var);
         Push_Scope_Via_Field_Ptr (Base_Info.Block_Decls_Type,
                                   Info.Block_Origin_Field,
                                   Info.Block_Decls_Type);
         --  Set iterator value.
         --  FIXME: this could be slighly optimized...
         declare
            Val : O_Dnode;
            If_Blk : O_If_Block;
         begin
            Val := Create_Temp (Iter_Type_Info.Ortho_Type (Mode_Value));
            Start_If_Stmt
              (If_Blk,
               New_Compare_Op (ON_Eq,
                               New_Value_Selected_Acc_Value
                               (New_Obj (Range_Ptr),
                                Iter_Type_Info.T.Range_Dir),
                               New_Lit (Ghdl_Dir_To_Node),
                               Ghdl_Bool_Type));
            New_Assign_Stmt (New_Obj (Val), New_Value_Selected_Acc_Value
                             (New_Obj (Range_Ptr),
                              Iter_Type_Info.T.Range_Left));
            New_Else_Stmt (If_Blk);
            New_Assign_Stmt (New_Obj (Val), New_Value_Selected_Acc_Value
                             (New_Obj (Range_Ptr),
                              Iter_Type_Info.T.Range_Right));
            Finish_If_Stmt (If_Blk);

            New_Assign_Stmt
              (Get_Var (Get_Info (Scheme).Iterator_Var),
               New_Dyadic_Op
               (ON_Add_Ov,
                New_Obj_Value (Val),
                New_Convert_Ov (New_Obj_Value (Var_I),
                                Iter_Type_Info.Ortho_Type (Mode_Value))));
         end;

         --  Elaboration.
         Elab_Block_Declarations (Stmt, Stmt);

         Pop_Scope (Base_Info.Block_Decls_Type);
         Pop_Scope (Info.Block_Decls_Type);

         Inc_Var (Var_I);
         Finish_Loop_Stmt (Label);
         Close_Temp;
      end Elab_Iterative_Generate_Statement;

      type Merge_Signals_Data is record
         Sig : Iir;
         Set_Init : Boolean;
         Has_Val : Boolean;
         Val : Mnode;
      end record;

      procedure Merge_Signals_Rti_Non_Composite (Targ : Mnode;
                                                 Targ_Type : Iir;
                                                 Data : Merge_Signals_Data)
      is
         Type_Info : Type_Info_Acc;
         Sig : Mnode;

         Init_Subprg : O_Dnode;
         Conv : O_Tnode;
         Assoc : O_Assoc_List;
         Init_Val : O_Enode;
      begin
         Type_Info := Get_Info (Targ_Type);

         Open_Temp;

         if Data.Set_Init then
            case Type_Info.Type_Mode is
               when Type_Mode_B2 =>
                  Init_Subprg := Ghdl_Signal_Init_B2;
                  Conv := Ghdl_Bool_Type;
               when Type_Mode_E8 =>
                  Init_Subprg := Ghdl_Signal_Init_E8;
                  Conv := Ghdl_I32_Type;
               when Type_Mode_E32 =>
                  Init_Subprg := Ghdl_Signal_Init_E32;
                  Conv := Ghdl_I32_Type;
               when Type_Mode_I32
                 | Type_Mode_P32 =>
                  Init_Subprg := Ghdl_Signal_Init_I32;
                  Conv := Ghdl_I32_Type;
               when Type_Mode_P64
                 | Type_Mode_I64 =>
                  Init_Subprg := Ghdl_Signal_Init_I64;
                  Conv := Ghdl_I64_Type;
               when Type_Mode_F64 =>
                  Init_Subprg := Ghdl_Signal_Init_F64;
                  Conv := Ghdl_Real_Type;
               when others =>
                  Error_Kind ("merge_signals_rti_non_composite", Targ_Type);
            end case;

            Sig := Stabilize (Targ, True);

            --  Init the signal.
            Start_Association (Assoc, Init_Subprg);
            New_Association
              (Assoc,
               New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
            if Data.Has_Val then
               Init_Val := M2E (Data.Val);
            else
               Init_Val := Chap14.Translate_Left_Type_Attribute (Targ_Type);
            end if;
            New_Association (Assoc, New_Convert_Ov (Init_Val, Conv));
            New_Procedure_Call (Assoc);
         else
            Sig := Targ;
         end if;

         Start_Association (Assoc, Ghdl_Signal_Merge_Rti);

         New_Association
           (Assoc, New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr));
         New_Association
           (Assoc,
            New_Lit (New_Global_Unchecked_Address
                     (Get_Info (Data.Sig).Object_Rti,
                      Rtis.Ghdl_Rti_Access)));
         New_Procedure_Call (Assoc);
         Close_Temp;
      end Merge_Signals_Rti_Non_Composite;

      function Merge_Signals_Rti_Prepare (Targ : Mnode;
                                          Targ_Type : Iir;
                                          Data : Merge_Signals_Data)
                                         return Merge_Signals_Data
      is
         pragma Unreferenced (Targ);
         pragma Unreferenced (Targ_Type);
         Res : Merge_Signals_Data;
      begin
         Res := Data;
         if Data.Has_Val then
            if Get_Type_Info (Data.Val).Type_Mode = Type_Mode_Record then
               Res.Val := Stabilize (Data.Val);
            else
               Res.Val := Chap3.Get_Array_Base (Data.Val);
            end if;
         end if;

         return Res;
      end Merge_Signals_Rti_Prepare;

      function Merge_Signals_Rti_Update_Data_Array
        (Data : Merge_Signals_Data; Targ_Type : Iir; Index : O_Dnode)
        return Merge_Signals_Data
      is
      begin
         if not Data.Has_Val then
            return Data;
         else
            return Merge_Signals_Data'
              (Sig => Data.Sig,
               Val => Chap3.Index_Base (Data.Val, Targ_Type,
                                        New_Obj_Value (Index)),
               Has_Val => True,
               Set_Init => Data.Set_Init);
         end if;
      end Merge_Signals_Rti_Update_Data_Array;

      procedure Merge_Signals_Rti_Finish_Data_Composite
        (Data : in out Merge_Signals_Data)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Merge_Signals_Rti_Finish_Data_Composite;

      function Merge_Signals_Rti_Update_Data_Record
        (Data : Merge_Signals_Data;
         Targ_Type : Iir;
         El : Iir_Element_Declaration) return Merge_Signals_Data
      is
         pragma Unreferenced (Targ_Type);
      begin
         if not Data.Has_Val then
            return Data;
         else
            return Merge_Signals_Data'
              (Sig => Data.Sig,
               Val => Chap6.Translate_Selected_Element (Data.Val, El),
               Has_Val => True,
               Set_Init => Data.Set_Init);
         end if;
      end Merge_Signals_Rti_Update_Data_Record;

      pragma Inline (Merge_Signals_Rti_Finish_Data_Composite);

      procedure Merge_Signals_Rti is new Foreach_Non_Composite
        (Data_Type => Merge_Signals_Data,
         Composite_Data_Type => Merge_Signals_Data,
         Do_Non_Composite => Merge_Signals_Rti_Non_Composite,
         Prepare_Data_Array => Merge_Signals_Rti_Prepare,
         Update_Data_Array => Merge_Signals_Rti_Update_Data_Array,
         Finish_Data_Array => Merge_Signals_Rti_Finish_Data_Composite,
         Prepare_Data_Record => Merge_Signals_Rti_Prepare,
         Update_Data_Record => Merge_Signals_Rti_Update_Data_Record,
         Finish_Data_Record => Merge_Signals_Rti_Finish_Data_Composite);

      procedure Merge_Signals_Rti_Of_Port_Chain (Chain : Iir)
      is
         Port : Iir;
         Port_Type : Iir;
         Data : Merge_Signals_Data;
         Val : Iir;
      begin
         Port := Chain;
         while Port /= Null_Iir loop
            Port_Type := Get_Type (Port);
            Data.Sig := Port;
            case Get_Mode (Port) is
               when Iir_Buffer_Mode
                 | Iir_Out_Mode
                 | Iir_Inout_Mode =>
                  Data.Set_Init := True;
               when others =>
                  Data.Set_Init := False;
            end case;

            Open_Temp;
            Val := Get_Default_Value (Port);
            if Val = Null_Iir then
               Data.Has_Val := False;
            else
               Data.Has_Val := True;
               Data.Val := E2M (Chap7.Translate_Expression (Val, Port_Type),
                                Get_Info (Port_Type),
                                Mode_Value);
            end if;

            Merge_Signals_Rti (Chap6.Translate_Name (Port), Port_Type, Data);
            Close_Temp;

            Port := Get_Chain (Port);
         end loop;
      end Merge_Signals_Rti_Of_Port_Chain;

      procedure Elab_Block_Declarations (Block : Iir; Base_Block : Iir)
      is
         Block_Info : Block_Info_Acc;
         Base_Info : Block_Info_Acc;
         Stmt : Iir;
         Final : Boolean;
      begin
         Block_Info := Get_Info (Block);
         Base_Info := Get_Info (Base_Block);

         New_Debug_Line_Stmt (Get_Line_Number (Block));

         case Get_Kind (Block) is
            when Iir_Kind_Entity_Declaration =>
               Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Block));
            when Iir_Kind_Architecture_Body =>
               null;
            when Iir_Kind_Block_Statement =>
               declare
                  Header : Iir_Block_Header;
                  Guard : Iir;
               begin
                  Guard := Get_Guard_Decl (Block);
                  if Guard /= Null_Iir then
                     New_Debug_Line_Stmt (Get_Line_Number (Guard));
                     Elab_Implicit_Guard_Signal (Block, Base_Info);
                  end if;
                  Header := Get_Block_Header (Block);
                  if Header /= Null_Iir then
                     New_Debug_Line_Stmt (Get_Line_Number (Header));
                     Chap5.Elab_Map_Aspect (Header, Block);
                     Merge_Signals_Rti_Of_Port_Chain (Get_Port_Chain (Header));
                  end if;
               end;
            when Iir_Kind_Generate_Statement =>
               null;
            when others =>
               Error_Kind ("elab_block_declarations", Block);
         end case;

         Open_Temp;
         Chap4.Elab_Declaration_Chain (Block, Final);
         Close_Temp;

         Stmt := Get_Concurrent_Statement_Chain (Block);
         while Stmt /= Null_Iir loop
            case Get_Kind (Stmt) is
               when Iir_Kind_Process_Statement
                 | Iir_Kind_Sensitized_Process_Statement =>
                  Elab_Process (Stmt, Block_Info, Base_Info);
               when Iir_Kind_Psl_Default_Clock =>
                  null;
               when Iir_Kind_Psl_Declaration =>
                  null;
               when Iir_Kind_Psl_Assert_Statement
                 | Iir_Kind_Psl_Cover_Statement =>
                  Elab_Psl_Directive (Stmt, Block_Info, Base_Info);
               when Iir_Kind_Component_Instantiation_Statement =>
                  declare
                     Info : Block_Info_Acc;
                     Constr : O_Assoc_List;
                  begin
                     Info := Get_Info (Stmt);
                     Start_Association (Constr, Info.Block_Elab_Subprg);
                     New_Association
                       (Constr, Get_Instance_Access (Base_Block));
                     New_Procedure_Call (Constr);
                  end;
                  --Elab_Component_Instantiation (Stmt, Block_Info);
               when Iir_Kind_Block_Statement =>
                  declare
                     Info : Block_Info_Acc;
                     Mark : Id_Mark_Type;
                  begin
                     Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
                     Info := Get_Info (Stmt);
                     Push_Scope (Info.Block_Decls_Type,
                                 Info.Block_Parent_Field,
                                 Block_Info.Block_Decls_Type);
                     Elab_Block_Declarations (Stmt, Base_Block);
                     Pop_Scope (Info.Block_Decls_Type);
                     Pop_Identifier_Prefix (Mark);
                  end;
               when Iir_Kind_Generate_Statement =>
                  declare
                     Mark : Id_Mark_Type;
                  begin
                     Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));

                     if Get_Kind (Get_Generation_Scheme (Stmt))
                       = Iir_Kind_Iterator_Declaration
                     then
                        Elab_Iterative_Generate_Statement
                          (Stmt, Block, Base_Block);
                     else
                        Elab_Conditionnal_Generate_Statement
                          (Stmt, Block, Base_Block);
                     end if;
                     Pop_Identifier_Prefix (Mark);
                  end;
               when others =>
                  Error_Kind ("elab_block_declarations", Stmt);
            end case;
            Stmt := Get_Chain (Stmt);
         end loop;
      end Elab_Block_Declarations;
   end Chap9;

   package body Chap10 is
      --  Identifiers.
      --  The following functions are helpers to create ortho identifiers.
      Identifier_Buffer : String (1 .. 512);
      Identifier_Len : Natural := 0;
      Identifier_Start : Natural := 1;
      Identifier_Local : Local_Identifier_Type := 0;


      Inst_Build : Inst_Build_Acc := null;
      procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
        (Object => Inst_Build_Type, Name => Inst_Build_Acc);

      procedure Set_Global_Storage (Storage : O_Storage) is
      begin
         Global_Storage := Storage;
      end Set_Global_Storage;

      procedure Pop_Build_Instance
      is
         Old : Inst_Build_Acc;
      begin
         Old := Inst_Build;
         Identifier_Start := Old.Prev_Id_Start;
         Inst_Build := Old.Prev;
         Unchecked_Deallocation (Old);
      end Pop_Build_Instance;

--       procedure Push_Global_Factory (Storage : O_Storage)
--       is
--          Inst : Inst_Build_Acc;
--       begin
--          if Inst_Build /= null then
--             raise Internal_Error;
--          end if;
--          Inst := new Inst_Build_Type (Global);
--          Inst.Prev := Inst_Build;
--          Inst_Build := Inst;
--          Global_Storage := Storage;
--       end Push_Global_Factory;

--       procedure Pop_Global_Factory is
--       begin
--          if Inst_Build.Kind /= Global then
--             raise Internal_Error;
--          end if;
--          Pop_Build_Instance;
--          Global_Storage := O_Storage_Private;
--       end Pop_Global_Factory;

      procedure Push_Instance_Factory (Instance_Type : O_Tnode)
      is
         Inst : Inst_Build_Acc;
      begin
         if Inst_Build /= null and then Inst_Build.Kind /= Instance then
            raise Internal_Error;
         end if;
         Inst := new Inst_Build_Type (Instance);
         Inst.Prev := Inst_Build;

         Inst.Prev_Id_Start := Identifier_Start;
         Identifier_Start := Identifier_Len + 1;

         if Instance_Type /= O_Tnode_Null then
            Start_Uncomplete_Record_Type (Instance_Type, Inst.Elements);
         else
            Start_Record_Type (Inst.Elements);
         end if;
         Inst.Vars := null;
         Inst_Build := Inst;
      end Push_Instance_Factory;

      function Add_Instance_Factory_Field (Name : O_Ident; Ftype : O_Tnode)
        return O_Fnode
      is
         Res : O_Fnode;
      begin
         New_Record_Field (Inst_Build.Elements, Res, Name, Ftype);
         return Res;
      end Add_Instance_Factory_Field;

      procedure Pop_Instance_Factory (Instance_Type : out O_Tnode)
      is
         Res : O_Tnode;
         V : Var_Acc;
      begin
         if Inst_Build.Kind /= Instance then
            --  Not matching.
            raise Internal_Error;
         end if;
         Finish_Record_Type (Inst_Build.Elements, Res);
         --  Set type of all variable declared in this instance.
         V := Inst_Build.Vars;
         while V /= null loop
            V.I_Type := Res;
            V := V.I_Link;
         end loop;
         Pop_Build_Instance;
         Instance_Type := Res;
      end Pop_Instance_Factory;

      procedure Push_Local_Factory
      is
         Inst : Inst_Build_Acc;
      begin
         if Inst_Build /= null
           and then (Inst_Build.Kind /= Global and Inst_Build.Kind /= Local)
         then
            --  Cannot create a local factory on an instance.
            raise Internal_Error;
         end if;
         Inst := new Inst_Build_Type (Kind => Local);
         Inst.Prev := Inst_Build;
         Inst.Prev_Global_Storage := Global_Storage;

         Inst.Prev_Id_Start := Identifier_Start;
         Identifier_Start := Identifier_Len + 1;

         Inst_Build := Inst;
         case Global_Storage is
            when O_Storage_Public =>
               Global_Storage := O_Storage_Private;
            when O_Storage_Private
              | O_Storage_External =>
               null;
            when O_Storage_Local =>
               raise Internal_Error;
         end case;
      end Push_Local_Factory;

      --  Return TRUE is the current scope is local.
      function Is_Local_Scope return Boolean is
      begin
         if Inst_Build = null then
            return False;
         end if;
         case Inst_Build.Kind is
            when Local
              | Instance =>
               return True;
            when Global =>
               return False;
         end case;
      end Is_Local_Scope;

      procedure Pop_Local_Factory is
      begin
         if Inst_Build.Kind /= Local then
            --  Not matching.
            raise Internal_Error;
         end if;
         Global_Storage := Inst_Build.Prev_Global_Storage;
         Pop_Build_Instance;
      end Pop_Local_Factory;

      type Scope_Type;
      type Scope_Acc is access Scope_Type;

      type Scope_Type is record
         --  True if the instance is a pointer.
         Is_Ptr : Boolean;

         --  Type of the scope.
         Stype : O_Tnode;

         --  Scope is within FIELD of scope PARENT.
         Field : O_Fnode;
         Parent : O_Tnode;

         --  Previous scope in the stack.
         Prev : Scope_Acc;
      end record;

      type Scope_Var_Type;
      type Scope_Var_Acc is access Scope_Var_Type;

      type Scope_Var_Type is record
         --  Type of the scope.
         Svtype : O_Tnode;

         --  Variable containing the reference of the scope.
         Var : O_Dnode;

         --  Previous variable in the stack.
         Prev : Scope_Var_Acc;
      end record;

      Scopes : Scope_Acc := null;
      --  Chained list of unused scopes, in order to reduce number of
      --  dynamic allocation.
      Scopes_Old : Scope_Acc := null;

      Scopes_Var : Scope_Var_Acc := null;
      --  Chained list of unused var_scopes, to reduce number of allocations.
      Scopes_Var_Old : Scope_Var_Acc := null;

      --  Get a scope, either from the list of free scope or by allocation.
      function Get_A_Scope return Scope_Acc is
         Res : Scope_Acc;
      begin
         if Scopes_Old /= null then
            Res := Scopes_Old;
            Scopes_Old := Scopes_Old.Prev;
         else
            Res := new Chap10.Scope_Type;
         end if;
         return Res;
      end Get_A_Scope;

      procedure Push_Scope (Scope_Type : O_Tnode;
                            Scope_Field : O_Fnode; Scope_Parent : O_Tnode)
      is
         Res : Scope_Acc;
      begin
         Res := Get_A_Scope;
         --  FIXME: check that Scope_Parent can be reached ?
         Res.all := (Is_Ptr => False,
                     Stype => Scope_Type,
                     Field => Scope_Field,
                     Parent => Scope_Parent,
                     Prev => Scopes);
         Scopes := Res;
      end Push_Scope;

      procedure Push_Scope_Via_Field_Ptr
        (Scope_Type : O_Tnode;
         Scope_Field : O_Fnode; Scope_Parent : O_Tnode)
      is
         Res : Scope_Acc;
      begin
         Res := Get_A_Scope;
         Res.all := (Is_Ptr => True,
                     Stype => Scope_Type,
                     Field => Scope_Field,
                     Parent => Scope_Parent,
                     Prev => Scopes);
         Scopes := Res;
      end Push_Scope_Via_Field_Ptr;

      procedure Push_Scope (Scope_Type : O_Tnode; Scope_Param : O_Dnode)
      is
         Res : Scope_Var_Acc;
      begin
         if Scopes_Var_Old /= null then
            Res := Scopes_Var_Old;
            Scopes_Var_Old := Res.Prev;
         else
            Res := new Scope_Var_Type;
         end if;
         Res.all := (Svtype => Scope_Type,
                     Var => Scope_Param,
                     Prev => Scopes_Var);
         Scopes_Var := Res;
      end Push_Scope;

      procedure Pop_Scope (Scope_Type : O_Tnode)
      is
         Old : Scope_Acc;
         Var_Old : Scope_Var_Acc;
      begin
         --  Search in var scope.
         if Scopes_Var /= null and then Scopes_Var.Svtype = Scope_Type then
            Var_Old := Scopes_Var;
            Scopes_Var := Var_Old.Prev;
            Var_Old.Prev := Scopes_Var_Old;
            Scopes_Var_Old := Var_Old;
         elsif Scopes.Stype /= Scope_Type then
            --  Bad pop order.
            raise Internal_Error;
         else
            Old := Scopes;
            Scopes := Old.Prev;
            Old.Prev := Scopes_Old;
            Scopes_Old := Old;
         end if;
      end Pop_Scope;

      function Create_Global_Var
        (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage)
        return Var_Acc
      is
         Var : O_Dnode;
      begin
         New_Var_Decl (Var, Name, Storage, Vtype);
         return new Var_Type'(Kind => Var_Global, E => Var);
      end Create_Global_Var;

      function Create_Global_Const
        (Name : O_Ident;
         Vtype : O_Tnode;
         Storage : O_Storage;
         Initial_Value : O_Cnode)
        return Var_Acc
      is
         Res : O_Dnode;
      begin
         New_Const_Decl (Res, Name, Storage, Vtype);
         if Storage /= O_Storage_External
           and then Initial_Value /= O_Cnode_Null
         then
            Start_Const_Value (Res);
            Finish_Const_Value (Res, Initial_Value);
         end if;
         return new Var_Type'(Kind => Var_Global, E => Res);
      end Create_Global_Const;

      procedure Define_Global_Const (Const : Var_Acc; Val : O_Cnode) is
      begin
         Start_Const_Value (Const.E);
         Finish_Const_Value (Const.E, Val);
      end Define_Global_Const;

      function Create_Var
        (Name : Var_Ident_Type;
         Vtype : O_Tnode;
         Storage : O_Storage := Global_Storage)
        return Var_Acc
      is
         Res : O_Dnode;
         Field : O_Fnode;
         V : Var_Acc;
         K : Inst_Build_Kind_Type;
      begin
         if Inst_Build = null then
            K := Global;
         else
            K := Inst_Build.Kind;
         end if;
         case K is
            when Global =>
               --  The global scope is in use...
               return Create_Global_Var (Name.Id, Vtype, Storage);
            when Local =>
               --  It is always possible to create a variable in a local scope.
               --  Create a var.
               New_Var_Decl (Res, Name.Id, O_Storage_Local, Vtype);
               return new Var_Type'(Kind => Var_Local, E => Res);
            when Instance =>
               --  Create a field.
               New_Record_Field (Inst_Build.Elements, Field, Name.Id, Vtype);
               V := new Var_Type'(Kind => Var_Scope, I_Field => Field,
                                  I_Type => O_Tnode_Null,
                                  I_Link => Inst_Build.Vars);
               Inst_Build.Vars := V;
               return V;
         end case;
      end Create_Var;

      --  Get a reference to scope STYPE. If IS_PTR is set, RES is an access
      --  to the scope, otherwise RES directly designates the scope.
      procedure Find_Scope_Type (Stype : O_Tnode;
                                 Res : out O_Lnode;
                                 Is_Ptr : out Boolean)
      is
         S : Scope_Acc;
         Sv : Scope_Var_Acc;
         Prev_Res : O_Lnode;
         Prev_Ptr : Boolean;
      begin
         --  Find in var.
         Sv := Scopes_Var;
         while Sv /= null loop
            if Sv.Svtype = Stype then
               Res := New_Obj (Sv.Var);
               Is_Ptr := True;
               return;
            end if;
            Sv := Sv.Prev;
         end loop;

         --  Find in fields.
         S := Scopes;
         while S /= null loop
            if S.Stype = Stype then
               Find_Scope_Type (S.Parent, Prev_Res, Prev_Ptr);
               if Prev_Ptr then
                  Prev_Res := New_Acc_Value (Prev_Res);
               end if;
               Res := New_Selected_Element (Prev_Res, S.Field);
               Is_Ptr := S.Is_Ptr;
               return;
            end if;
            S := S.Prev;
         end loop;

         --  Not found.
         raise Internal_Error;
      end Find_Scope_Type;

      procedure Check_Not_Building is
      begin
         --  Variables cannot be referenced if there is an instance being
         --  built.
         if Inst_Build /= null and then Inst_Build.Kind = Instance then
            raise Internal_Error;
         end if;
      end Check_Not_Building;

      function Get_Instance_Access (Block : Iir) return O_Enode
      is
         Info : constant Block_Info_Acc := Get_Info (Block);
         Res : O_Lnode;
         Is_Ptr : Boolean;
      begin
         Check_Not_Building;
         Find_Scope_Type (Info.Block_Decls_Type, Res, Is_Ptr);
         if Is_Ptr then
            return New_Value (Res);
         else
            return New_Address (Res, Info.Block_Decls_Ptr_Type);
         end if;
      end Get_Instance_Access;

      function Get_Instance_Ref (Itype : O_Tnode) return O_Lnode
      is
         Res : O_Lnode;
         Is_Ptr : Boolean;
      begin
         Check_Not_Building;
         Find_Scope_Type (Itype, Res, Is_Ptr);
         if Is_Ptr then
            return New_Acc_Value (Res);
         else
            return Res;
         end if;
      end Get_Instance_Ref;

      function Get_Var (Var : Var_Acc) return O_Lnode
      is
      begin
         case Var.Kind is
            when Var_Local
              | Var_Global =>
               return New_Obj (Var.E);
            when Var_Scope =>
               null;
         end case;

         return New_Selected_Element (Get_Instance_Ref (Var.I_Type),
                                      Var.I_Field);
      end Get_Var;

      function Get_Alloc_Kind_For_Var (Var : Var_Acc) return Allocation_Kind is
      begin
         case Var.Kind is
            when Var_Local =>
               return Alloc_Stack;
            when Var_Global
              | Var_Scope =>
               return Alloc_System;
         end case;
      end Get_Alloc_Kind_For_Var;

      function Is_Var_Stable (Var : Var_Acc) return Boolean is
      begin
         case Var.Kind is
            when Var_Local
              | Var_Global =>
               return True;
            when Var_Scope =>
               return False;
         end case;
      end Is_Var_Stable;

      function Is_Var_Field (Var : Var_Acc) return Boolean is
      begin
         case Var.Kind is
            when Var_Local
              | Var_Global =>
               return False;
            when Var_Scope =>
               return True;
         end case;
      end Is_Var_Field;

      function Get_Var_Field (Var : Var_Acc) return O_Fnode is
      begin
         case Var.Kind is
            when Var_Local
              | Var_Global =>
               raise Internal_Error;
            when Var_Scope =>
               return Var.I_Field;
         end case;
      end Get_Var_Field;

      function Get_Var_Record (Var : Var_Acc) return O_Tnode is
      begin
         case Var.Kind is
            when Var_Local
              | Var_Global =>
               raise Internal_Error;
            when Var_Scope =>
               return Var.I_Type;
         end case;
      end Get_Var_Record;

      function Get_Var_Label (Var : Var_Acc) return O_Dnode is
      begin
         case Var.Kind is
            when Var_Local
              | Var_Global =>
               return Var.E;
            when Var_Scope =>
               raise Internal_Error;
         end case;
      end Get_Var_Label;

      procedure Free_Var (Var : in out Var_Acc)
      is
         procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
           (Var_Type, Var_Acc);
      begin
         Unchecked_Deallocation (Var);
      end Free_Var;

      procedure Save_Local_Identifier (Id : out Local_Identifier_Type) is
      begin
         Id := Identifier_Local;
      end Save_Local_Identifier;

      procedure Restore_Local_Identifier (Id : Local_Identifier_Type) is
      begin
         if Identifier_Local > Id then
            --  If the value is restored with a smaller value, some identifiers
            --  will be reused.  This is certainly an internal error.
            raise Internal_Error;
         end if;
         Identifier_Local := Id;
      end Restore_Local_Identifier;

      --  Reset the identifier.
      procedure Reset_Identifier_Prefix is
      begin
         if Identifier_Len /= 0 or else Identifier_Local /= 0 then
            raise Internal_Error;
         end if;
      end Reset_Identifier_Prefix;

      procedure Pop_Identifier_Prefix (Mark : in Id_Mark_Type) is
      begin
         Identifier_Len := Mark.Len;
         Identifier_Local := Mark.Local_Id;
      end Pop_Identifier_Prefix;

      procedure Add_String (Len : in out Natural; Str : String) is
      begin
         Identifier_Buffer (Len + 1 .. Len + Str'Length) := Str;
         Len := Len + Str'Length;
      end Add_String;

      procedure Add_Nat (Len : in out Natural; Val : Natural)
      is
         Num : String (1 .. 10);
         V : Natural;
         P : Natural;
      begin
         P := Num'Last;
         V := Val;
         loop
            Num (P) := Character'Val (Character'Pos ('0') + V mod 10);
            V := V / 10;
            exit when V = 0;
            P := P - 1;
         end loop;
         Add_String (Len, Num (P .. Num'Last));
      end Add_Nat;

      --  Convert name_id NAME to a string stored to
      --  NAME_BUFFER (1 .. NAME_LENGTH).
      --
      --  This encodes extended identifiers.
      --
      --  Extended identifier encoding:
      --  They start with 'X'.
      --  Non extended character [0-9a-zA-Z] are left as is,
      --  others are encoded to _XX, where XX is the character position in hex.
      --  They finish with "__".
      procedure Name_Id_To_String (Name : Name_Id)
      is
         use Name_Table;

         type Bool_Array_Type is array (Character) of Boolean;
         pragma Pack (Bool_Array_Type);
         Is_Extended_Char : constant Bool_Array_Type :=
           ('0' .. '9' | 'A' .. 'Z' | 'a' .. 'z' => False,
            others => True);

         N_Len : Natural;
         P : Natural;
         C : Character;
      begin
         if Is_Character (Name) then
            P := Character'Pos (Name_Table.Get_Character (Name));
            Name_Buffer (1) := 'C';
            Name_Buffer (2) := N2hex (P / 16);
            Name_Buffer (3) := N2hex (P mod 16);
            Name_Length := 3;
            return;
         else
            Image (Name);
         end if;
         if Name_Buffer (1) /= '\' then
            return;
         end if;
         --  Extended identifier.
         --  Supress trailing backslash.
         Name_Length := Name_Length - 1;

         --  Count number of characters in the extended string.
         N_Len := Name_Length;
         for I in 2 .. Name_Length loop
            if Is_Extended_Char (Name_Buffer (I)) then
               N_Len := N_Len + 2;
            end if;
         end loop;

         --  Convert.
         Name_Buffer (1) := 'X';
         P := N_Len;
         for J in reverse 2 .. Name_Length loop
            C := Name_Buffer (J);
            if Is_Extended_Char (C) then
               Name_Buffer (P - 0) := N2hex (Character'Pos (C) mod 16);
               Name_Buffer (P - 1) := N2hex (Character'Pos (C) / 16);
               Name_Buffer (P - 2) := '_';
               P := P - 3;
            else
               Name_Buffer (P) := C;
               P := P - 1;
            end if;
         end loop;
         Name_Buffer (N_Len + 1) := '_';
         Name_Buffer (N_Len + 2) := '_';
         Name_Length := N_Len + 2;
      end Name_Id_To_String;

      procedure Add_Name (Len : in out Natural; Name : Name_Id)
      is
         use Name_Table;
      begin
         Name_Id_To_String (Name);
         Add_String (Len, Name_Buffer (1 .. Name_Length));
      end Add_Name;

      procedure Push_Identifier_Prefix (Mark : out Id_Mark_Type;
                                        Name : String;
                                        Val : Iir_Int32 := 0)
      is
         P : Natural;
      begin
         Mark.Len := Identifier_Len;
         Mark.Local_Id := Identifier_Local;
         Identifier_Local := 0;
         P := Identifier_Len;
         Add_String (P, Name);
         if Val > 0 then
            Add_String (P, "O");
            Add_Nat (P, Natural (Val));
         end if;
         Add_String (P, "__");
         Identifier_Len := P;
      end Push_Identifier_Prefix;

      --  Add a suffix to the prefix (!!!).
      procedure Push_Identifier_Prefix
        (Mark : out Id_Mark_Type; Name : Name_Id; Val : Iir_Int32 := 0)
      is
         use Name_Table;
      begin
         Name_Id_To_String (Name);
         Push_Identifier_Prefix (Mark, Name_Buffer (1 .. Name_Length), Val);
      end Push_Identifier_Prefix;

      procedure Push_Identifier_Prefix_Uniq (Mark : out Id_Mark_Type)
      is
         Str : String := Local_Identifier_Type'Image (Identifier_Local);
      begin
         Identifier_Local := Identifier_Local + 1;
         Str (1) := 'U';
         Push_Identifier_Prefix (Mark, Str, 0);
      end Push_Identifier_Prefix_Uniq;

      procedure Add_Identifier (Len : in out Natural; Id : Name_Id) is
      begin
         if Id /= Null_Identifier then
            Add_Name (Len, Id);
         end if;
      end Add_Identifier;

      --  Create an identifier from IIR node ID without the prefix.
      function Create_Identifier_Without_Prefix (Id : Iir) return O_Ident
      is
         use Name_Table;
      begin
         Name_Id_To_String (Get_Identifier (Id));
         return Get_Identifier (Name_Buffer (1 .. Name_Length));
      end Create_Identifier_Without_Prefix;

      function Create_Identifier_Without_Prefix (Id : Name_Id; Str : String)
        return O_Ident
      is
         use Name_Table;
      begin
         Name_Id_To_String (Id);
         Name_Buffer (Name_Length + 1 .. Name_Length + Str'Length) := Str;
         return Get_Identifier (Name_Buffer (1 .. Name_Length + Str'Length));
      end Create_Identifier_Without_Prefix;

      --  Create an identifier from IIR node ID with prefix.
      function Create_Id (Id : Name_Id; Str : String; Is_Local : Boolean)
        return O_Ident
      is
         L : Natural;
      begin
         L := Identifier_Len;
         Add_Identifier (L, Id);
         Add_String (L, Str);
         --Identifier_Buffer (L + Str'Length + 1) := Nul;
         if Is_Local then
            return Get_Identifier
              (Identifier_Buffer (Identifier_Start .. L));
         else
            return Get_Identifier (Identifier_Buffer (1 .. L));
         end if;
      end Create_Id;

      function Create_Identifier (Id : Name_Id; Str : String := "")
        return O_Ident
      is
      begin
         return Create_Id (Id, Str, False);
      end Create_Identifier;

      function Create_Identifier (Id : Iir; Str : String := "")
        return O_Ident
      is
      begin
         return Create_Id (Get_Identifier (Id), Str, False);
      end Create_Identifier;

      function Create_Identifier
        (Id : Iir; Val : Iir_Int32; Str : String := "")
        return O_Ident
      is
         Len : Natural;
      begin
         Len := Identifier_Len;
         Add_Identifier (Len, Get_Identifier (Id));

         if Val > 0 then
            Add_String (Len, "O");
            Add_Nat (Len, Natural (Val));
         end if;
         Add_String (Len, Str);
         return Get_Identifier (Identifier_Buffer (1 .. Len));
      end Create_Identifier;

      function Create_Identifier (Str : String)
        return O_Ident
      is
         Len : Natural;
      begin
         Len := Identifier_Len;
         Add_String (Len, Str);
         return Get_Identifier (Identifier_Buffer (1 .. Len));
      end Create_Identifier;

      function Create_Identifier return O_Ident
      is
      begin
         return Get_Identifier (Identifier_Buffer (1 .. Identifier_Len - 2));
      end Create_Identifier;

      function Create_Var_Identifier_From_Buffer (L : Natural)
        return Var_Ident_Type
      is
         Start : Natural;
      begin
         if Is_Local_Scope then
            Start := Identifier_Start;
         else
            Start := 1;
         end if;
         return (Id => Get_Identifier (Identifier_Buffer (Start .. L)));
      end Create_Var_Identifier_From_Buffer;

      function Create_Var_Identifier (Id : Iir)
        return Var_Ident_Type
      is
         L : Natural := Identifier_Len;
      begin
         Add_Identifier (L, Get_Identifier (Id));
         return Create_Var_Identifier_From_Buffer (L);
      end Create_Var_Identifier;

      function Create_Var_Identifier (Id : String)
        return Var_Ident_Type
      is
         L : Natural := Identifier_Len;
      begin
         Add_String (L, Id);
         return Create_Var_Identifier_From_Buffer (L);
      end Create_Var_Identifier;

      function Create_Var_Identifier (Id : Iir; Str : String; Val : Natural)
        return Var_Ident_Type
      is
         L : Natural := Identifier_Len;
      begin
         Add_Identifier (L, Get_Identifier (Id));
         Add_String (L, Str);
         if Val > 0 then
            Add_String (L, "O");
            Add_Nat (L, Val);
         end if;
         return Create_Var_Identifier_From_Buffer (L);
      end Create_Var_Identifier;

      function Create_Uniq_Identifier return Var_Ident_Type
      is
         Res : Var_Ident_Type;
      begin
         Res.Id := Create_Uniq_Identifier;
         return Res;
      end Create_Uniq_Identifier;
   end Chap10;

   package body Chap14 is
      function Translate_Array_Attribute_To_Range (Expr : Iir) return Mnode
      is
         Prefix : constant Iir := Get_Prefix (Expr);
         Type_Name : constant Iir := Is_Type_Name (Prefix);
         Arr : Mnode;
         Dim : Natural;
      begin
         if Type_Name /= Null_Iir then
            --  Prefix denotes a type name
            Arr := T2M (Type_Name, Mode_Value);
         else
            --  Prefix is an object.
            Arr := Chap6.Translate_Name (Prefix);
         end if;
         Dim := Natural (Get_Value (Get_Parameter (Expr)));
         return Chap3.Get_Array_Range (Arr, Get_Type (Prefix), Dim);
      end Translate_Array_Attribute_To_Range;

      function Translate_Range_Array_Attribute (Expr : Iir)
        return O_Lnode is
      begin
         return M2Lv (Translate_Array_Attribute_To_Range (Expr));
      end Translate_Range_Array_Attribute;

      function Translate_Length_Array_Attribute (Expr : Iir; Rtype : Iir)
        return O_Enode
      is
         Rng : Mnode;
         Val : O_Enode;
      begin
         Rng := Translate_Array_Attribute_To_Range (Expr);
         Val := M2E (Chap3.Range_To_Length (Rng));
         if Rtype /= Null_Iir then
            Val := New_Convert_Ov (Val, Get_Ortho_Type (Rtype, Mode_Value));
         end if;
         return Val;
      end Translate_Length_Array_Attribute;

      --  Extract high or low bound of RANGE_VAR.
      function Range_To_High_Low
        (Range_Var : Mnode; Range_Type : Iir; Is_High : Boolean)
        return Mnode
      is
         Op : ON_Op_Kind;
         If_Blk : O_If_Block;
         Range_Svar : constant Mnode := Stabilize (Range_Var);
         Res : O_Dnode;
         Tinfo : constant Ortho_Info_Acc :=
           Get_Info (Get_Base_Type (Range_Type));
      begin
         Res := Create_Temp (Tinfo.Ortho_Type (Mode_Value));
         Open_Temp;
         if Is_High then
            Op := ON_Neq;
         else
            Op := ON_Eq;
         end if;
         Start_If_Stmt (If_Blk,
                        New_Compare_Op (Op,
                                        M2E (Chap3.Range_To_Dir (Range_Svar)),
                                        New_Lit (Ghdl_Dir_To_Node),
                                        Ghdl_Bool_Type));
         New_Assign_Stmt (New_Obj (Res),
                          M2E (Chap3.Range_To_Left (Range_Svar)));
         New_Else_Stmt (If_Blk);
         New_Assign_Stmt (New_Obj (Res),
                          M2E (Chap3.Range_To_Right (Range_Svar)));
         Finish_If_Stmt (If_Blk);
         Close_Temp;
         return Dv2M (Res, Tinfo, Mode_Value);
      end Range_To_High_Low;

      function Translate_High_Low_Type_Attribute
        (Attr : Iir; Is_High : Boolean) return O_Enode
      is
         Attr_Type : constant Iir := Get_Type (Attr);
         Tinfo : constant Ortho_Info_Acc := Get_Info (Attr_Type);
      begin
         return M2E
           (Chap14.Range_To_High_Low
              (Lv2M (Chap7.Translate_Range (Get_Prefix (Attr), Attr_Type),
                     True,
                     Tinfo.T.Range_Type, Tinfo.T.Range_Ptr_Type,
                     Tinfo, Mode_Value),
               Attr_Type, Is_High));
      end Translate_High_Low_Type_Attribute;

      function Translate_High_Low_Array_Attribute (Expr : Iir;
                                                   Is_High : Boolean)
                                                  return O_Enode
      is
      begin
         return M2E (Range_To_High_Low
                       (Translate_Array_Attribute_To_Range (Expr),
                        Get_Type (Expr), Is_High));
      end Translate_High_Low_Array_Attribute;

      function Translate_Low_Array_Attribute (Expr : Iir)
        return O_Enode
      is
      begin
         return Translate_High_Low_Array_Attribute (Expr, False);
      end Translate_Low_Array_Attribute;

      function Translate_High_Array_Attribute (Expr : Iir)
        return O_Enode
      is
      begin
         return Translate_High_Low_Array_Attribute (Expr, True);
      end Translate_High_Array_Attribute;

      function Translate_Left_Array_Attribute (Expr : Iir)
        return O_Enode
      is
         Rng : Mnode;
      begin
         Rng := Translate_Array_Attribute_To_Range (Expr);
         return M2E (Chap3.Range_To_Left (Rng));
      end Translate_Left_Array_Attribute;

      function Translate_Right_Array_Attribute (Expr : Iir)
        return O_Enode
      is
         Rng : Mnode;
      begin
         Rng := Translate_Array_Attribute_To_Range (Expr);
         return M2E (Chap3.Range_To_Right (Rng));
      end Translate_Right_Array_Attribute;

      function Translate_Ascending_Array_Attribute (Expr : Iir)
        return O_Enode
      is
         Rng : Mnode;
      begin
         Rng := Translate_Array_Attribute_To_Range (Expr);
         return New_Compare_Op (ON_Eq,
                                M2E (Chap3.Range_To_Dir (Rng)),
                                New_Lit (Ghdl_Dir_To_Node),
                                Std_Boolean_Type_Node);
      end Translate_Ascending_Array_Attribute;

      function Translate_Left_Type_Attribute (Atype : Iir) return O_Enode is
      begin
         if Get_Type_Staticness (Atype) = Locally then
            return New_Lit (Chap7.Translate_Static_Range_Left
                            (Get_Range_Constraint (Atype), Atype));
         else
            return M2E (Chap3.Range_To_Left (Chap3.Type_To_Range (Atype)));
         end if;
      end Translate_Left_Type_Attribute;

      function Translate_Right_Type_Attribute (Atype : Iir) return O_Enode is
      begin
         if Get_Type_Staticness (Atype) = Locally then
            return New_Lit (Chap7.Translate_Static_Range_Right
                            (Get_Range_Constraint (Atype), Atype));
         else
            return M2E (Chap3.Range_To_Right (Chap3.Type_To_Range (Atype)));
         end if;
      end Translate_Right_Type_Attribute;

      function Translate_Dir_Type_Attribute (Atype : Iir) return O_Enode
      is
         Info : Type_Info_Acc;
      begin
         if Get_Type_Staticness (Atype) = Locally then
            return New_Lit (Chap7.Translate_Static_Range_Dir
                            (Get_Range_Constraint (Atype)));
         else
            Info := Get_Info (Atype);
            return New_Value
              (New_Selected_Element (Get_Var (Info.T.Range_Var),
                                     Info.T.Range_Dir));
         end if;
      end Translate_Dir_Type_Attribute;

      function Translate_Val_Attribute (Attr : Iir) return O_Enode
      is
         Val : O_Enode;
         Attr_Type : Iir;
         Res_Var : O_Dnode;
         Res_Type : O_Tnode;
      begin
         Attr_Type := Get_Type (Attr);
         Res_Type := Get_Ortho_Type (Attr_Type, Mode_Value);
         Res_Var := Create_Temp (Res_Type);
         Val := Chap7.Translate_Expression (Get_Parameter (Attr));

         case Get_Kind (Attr_Type) is
            when Iir_Kind_Enumeration_Type_Definition
              | Iir_Kind_Enumeration_Subtype_Definition =>
               --  For enumeration, always check the value is in the enum
               --  range.
               declare
                  Val_Type : O_Tnode;
                  Val_Var : O_Dnode;
                  If_Blk : O_If_Block;
               begin
                  Val_Type := Get_Ortho_Type (Get_Type (Get_Parameter (Attr)),
                                              Mode_Value);
                  Val_Var := Create_Temp_Init (Val_Type, Val);
                  Start_If_Stmt
                    (If_Blk,
                     New_Dyadic_Op
                     (ON_Or,
                      New_Compare_Op (ON_Lt,
                                      New_Obj_Value (Val_Var),
                                      New_Lit (New_Signed_Literal
                                               (Val_Type, 0)),
                                      Ghdl_Bool_Type),
                      New_Compare_Op (ON_Ge,
                                      New_Obj_Value (Val_Var),
                                      New_Lit (New_Signed_Literal
                                               (Val_Type,
                                                Integer_64
                                                (Get_Nbr_Elements
                                                 (Get_Enumeration_Literal_List
                                                  (Attr_Type))))),
                                      Ghdl_Bool_Type)));
                  Chap6.Gen_Bound_Error (Attr);
                  Finish_If_Stmt (If_Blk);
                  Val := New_Obj_Value (Val_Var);
               end;
            when others =>
               null;
         end case;

         New_Assign_Stmt (New_Obj (Res_Var), New_Convert_Ov (Val, Res_Type));
         Chap3.Check_Range
           (Res_Var, Attr, Get_Type (Get_Prefix (Attr)), Attr);
         return New_Obj_Value (Res_Var);
      end Translate_Val_Attribute;

      function Translate_Pos_Attribute (Attr : Iir; Res_Type : Iir)
        return O_Enode
      is
         T : O_Dnode;
         Ttype : O_Tnode;
      begin
         Ttype := Get_Ortho_Type (Res_Type, Mode_Value);
         T := Create_Temp (Ttype);
         New_Assign_Stmt
           (New_Obj (T),
            New_Convert_Ov (Chap7.Translate_Expression (Get_Parameter (Attr)),
                            Ttype));
         Chap3.Check_Range (T, Attr, Res_Type, Attr);
         return New_Obj_Value (T);
      end Translate_Pos_Attribute;

      function Translate_Succ_Pred_Attribute (Attr : Iir) return O_Enode
      is
         Expr_Type : Iir;
         Tinfo : Type_Info_Acc;
         Ttype : O_Tnode;
         Expr : O_Enode;
         List : Iir_List;
         Limit : Iir;
         Is_Succ : Boolean;
         Op : ON_Op_Kind;
      begin
         --  FIXME: should check bounds.
         Expr_Type := Get_Type (Attr);
         Tinfo := Get_Info (Expr_Type);
         Expr := Chap7.Translate_Expression (Get_Parameter (Attr), Expr_Type);
         Ttype := Tinfo.Ortho_Type (Mode_Value);
         Is_Succ := Get_Kind (Attr) = Iir_Kind_Succ_Attribute;
         if Is_Succ then
            Op := ON_Add_Ov;
         else
            Op := ON_Sub_Ov;
         end if;
         case Tinfo.Type_Mode is
            when Type_Mode_B2
              | Type_Mode_E8
              | Type_Mode_E32 =>
               --  Should check it is not the last.
               declare
                  L : O_Dnode;
               begin
                  List := Get_Enumeration_Literal_List (Get_Base_Type
                                                        (Expr_Type));
                  L := Create_Temp_Init (Ttype, Expr);
                  if Is_Succ then
                     Limit := Get_Last_Element (List);
                  else
                     Limit := Get_First_Element (List);
                  end if;
                  Chap6.Check_Bound_Error
                    (New_Compare_Op (ON_Eq,
                                     New_Obj_Value (L),
                                     New_Lit (Get_Ortho_Expr (Limit)),
                                     Ghdl_Bool_Type),
                     Attr, 0);
                  return New_Convert_Ov
                    (New_Dyadic_Op
                     (Op,
                      New_Convert_Ov (New_Obj_Value (L), Ghdl_I32_Type),
                      New_Lit (New_Signed_Literal (Ghdl_I32_Type, 1))),
                     Ttype);
               end;
            when Type_Mode_I32
              | Type_Mode_P64 =>
               return New_Dyadic_Op
                 (Op, Expr, New_Lit (New_Signed_Literal (Ttype, 1)));
            when others =>
               raise Internal_Error;
         end case;
      end Translate_Succ_Pred_Attribute;

      type Bool_Sigattr_Data_Type is record
         Label : O_Snode;
         Field : O_Fnode;
      end record;

      procedure Bool_Sigattr_Non_Composite_Signal
        (Targ : Mnode; Targ_Type : Iir; Data : Bool_Sigattr_Data_Type)
      is
         pragma Unreferenced (Targ_Type);
      begin
         Gen_Exit_When (Data.Label,
                        New_Value (Get_Signal_Field (Targ, Data.Field)));
      end Bool_Sigattr_Non_Composite_Signal;

      function Bool_Sigattr_Prepare_Data_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Bool_Sigattr_Data_Type)
        return Bool_Sigattr_Data_Type
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Data;
      end Bool_Sigattr_Prepare_Data_Composite;

      function Bool_Sigattr_Update_Data_Array (Data : Bool_Sigattr_Data_Type;
                                               Targ_Type : Iir;
                                               Index : O_Dnode)
        return Bool_Sigattr_Data_Type
      is
         pragma Unreferenced (Targ_Type, Index);
      begin
         return Data;
      end Bool_Sigattr_Update_Data_Array;

      function Bool_Sigattr_Update_Data_Record (Data : Bool_Sigattr_Data_Type;
                                                Targ_Type : Iir;
                                                El : Iir_Element_Declaration)
        return Bool_Sigattr_Data_Type
      is
         pragma Unreferenced (Targ_Type, El);
      begin
         return Data;
      end Bool_Sigattr_Update_Data_Record;

      procedure Bool_Sigattr_Finish_Data_Composite
        (Data : in out Bool_Sigattr_Data_Type)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Bool_Sigattr_Finish_Data_Composite;

      procedure Bool_Sigattr_Foreach is new Foreach_Non_Composite
        (Data_Type => Bool_Sigattr_Data_Type,
         Composite_Data_Type => Bool_Sigattr_Data_Type,
         Do_Non_Composite => Bool_Sigattr_Non_Composite_Signal,
         Prepare_Data_Array => Bool_Sigattr_Prepare_Data_Composite,
         Update_Data_Array => Bool_Sigattr_Update_Data_Array,
         Finish_Data_Array => Bool_Sigattr_Finish_Data_Composite,
         Prepare_Data_Record => Bool_Sigattr_Prepare_Data_Composite,
         Update_Data_Record => Bool_Sigattr_Update_Data_Record,
         Finish_Data_Record => Bool_Sigattr_Finish_Data_Composite);

      function Translate_Bool_Signal_Attribute (Attr : Iir; Field : O_Fnode)
                                               return O_Enode
      is
         Data : Bool_Sigattr_Data_Type;
         Res : O_Dnode;
         Name : Mnode;
         Prefix : Iir;
         Prefix_Type : Iir;
      begin
         Prefix := Get_Prefix (Attr);
         Prefix_Type := Get_Type (Prefix);

         if Get_Kind (Prefix_Type) in Iir_Kinds_Scalar_Type_Definition then
            --  Effecient handling for a scalar signal.
            Name := Chap6.Translate_Name (Prefix);
            return New_Value (Get_Signal_Field (Name, Field));
         else
            --  Element per element handling for composite signals.
            Res := Create_Temp (Std_Boolean_Type_Node);
            Open_Temp;
            New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_True_Node));
            Name := Chap6.Translate_Name (Prefix);
            Start_Loop_Stmt (Data.Label);
            Data.Field := Field;
            Bool_Sigattr_Foreach (Name, Prefix_Type, Data);
            New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_False_Node));
            New_Exit_Stmt (Data.Label);
            Finish_Loop_Stmt (Data.Label);
            Close_Temp;
            return New_Obj_Value (Res);
         end if;
      end Translate_Bool_Signal_Attribute;

      function Translate_Event_Attribute (Attr : Iir) return O_Enode is
      begin
         return Translate_Bool_Signal_Attribute
           (Attr, Ghdl_Signal_Event_Field);
      end Translate_Event_Attribute;

      function Translate_Active_Attribute (Attr : Iir) return O_Enode is
      begin
         return Translate_Bool_Signal_Attribute
           (Attr, Ghdl_Signal_Active_Field);
      end Translate_Active_Attribute;

      --  Read signal value FIELD of signal SIG.
      function Get_Signal_Value_Field
        (Sig : O_Enode; Sig_Type : Iir; Field : O_Fnode)
        return O_Lnode
      is
         S_Type : O_Tnode;
         T : O_Lnode;
      begin
         S_Type := Get_Ortho_Type (Sig_Type, Mode_Signal);
         T := New_Access_Element (New_Convert_Ov (Sig, Ghdl_Signal_Ptr));
         return New_Access_Element
           (New_Unchecked_Address (New_Selected_Element (T, Field), S_Type));
      end Get_Signal_Value_Field;

      function Get_Signal_Field (Sig : Mnode; Field : O_Fnode)
                                return O_Lnode
      is
         S : O_Enode;
      begin
         S := New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr);
         return New_Selected_Element (New_Access_Element (S), Field);
      end Get_Signal_Field;

      function Read_Last_Value (Sig : O_Enode; Sig_Type : Iir) return O_Enode
      is
      begin
         return New_Value (Get_Signal_Value_Field
                           (Sig, Sig_Type, Ghdl_Signal_Last_Value_Field));
      end Read_Last_Value;

      function Translate_Last_Value is new Chap7.Translate_Signal_Value
        (Read_Value => Read_Last_Value);

      function Translate_Last_Value_Attribute (Attr : Iir) return O_Enode
      is
         Name : Mnode;
         Prefix : Iir;
         Prefix_Type : Iir;
      begin
         Prefix := Get_Prefix (Attr);
         Prefix_Type := Get_Type (Prefix);

         Name := Chap6.Translate_Name (Prefix);
         if Get_Object_Kind (Name) /= Mode_Signal then
            raise Internal_Error;
         end if;
         return Translate_Last_Value (M2E (Name), Prefix_Type);
      end Translate_Last_Value_Attribute;

      function Read_Last_Time (Sig : O_Enode; Field : O_Fnode) return O_Enode
      is
         T : O_Lnode;
      begin
         T := New_Access_Element (New_Convert_Ov (Sig, Ghdl_Signal_Ptr));
         return New_Value (New_Selected_Element (T, Field));
      end Read_Last_Time;

      type Last_Time_Data is record
         Var : O_Dnode;
         Field : O_Fnode;
      end record;

      procedure Translate_Last_Time_Non_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Last_Time_Data)
      is
         pragma Unreferenced (Targ_Type);
         Val : O_Dnode;
         If_Blk : O_If_Block;
      begin
         Open_Temp;
         Val := Create_Temp_Init
           (Std_Time_Type,
            Read_Last_Time (New_Value (M2Lv (Targ)), Data.Field));
         Start_If_Stmt (If_Blk,
                        New_Compare_Op (ON_Gt,
                                        New_Obj_Value (Val),
                                        New_Obj_Value (Data.Var),
                                        Ghdl_Bool_Type));
         New_Assign_Stmt (New_Obj (Data.Var), New_Obj_Value (Val));
         Finish_If_Stmt (If_Blk);
         Close_Temp;
      end Translate_Last_Time_Non_Composite;

      function Last_Time_Prepare_Data_Composite
        (Targ : Mnode; Targ_Type : Iir; Data : Last_Time_Data)
        return Last_Time_Data
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Data;
      end Last_Time_Prepare_Data_Composite;

      function Last_Time_Update_Data_Array (Data : Last_Time_Data;
                                            Targ_Type : Iir;
                                            Index : O_Dnode)
                                           return Last_Time_Data
      is
         pragma Unreferenced (Targ_Type, Index);
      begin
         return Data;
      end Last_Time_Update_Data_Array;

      function Last_Time_Update_Data_Record (Data : Last_Time_Data;
                                             Targ_Type : Iir;
                                             El : Iir_Element_Declaration)
                                            return Last_Time_Data
      is
         pragma Unreferenced (Targ_Type, El);
      begin
         return Data;
      end Last_Time_Update_Data_Record;

      procedure Last_Time_Finish_Data_Composite
        (Data : in out Last_Time_Data)
      is
         pragma Unreferenced (Data);
      begin
         null;
      end Last_Time_Finish_Data_Composite;

      procedure Translate_Last_Time is new Foreach_Non_Composite
        (Data_Type => Last_Time_Data,
         Composite_Data_Type => Last_Time_Data,
         Do_Non_Composite => Translate_Last_Time_Non_Composite,
         Prepare_Data_Array => Last_Time_Prepare_Data_Composite,
         Update_Data_Array => Last_Time_Update_Data_Array,
         Finish_Data_Array => Last_Time_Finish_Data_Composite,
         Prepare_Data_Record => Last_Time_Prepare_Data_Composite,
         Update_Data_Record => Last_Time_Update_Data_Record,
         Finish_Data_Record => Last_Time_Finish_Data_Composite);

      function Translate_Last_Time_Attribute (Prefix : Iir; Field : O_Fnode)
        return O_Enode
      is
         Prefix_Type : Iir;
         Name : Mnode;
         Info : Type_Info_Acc;
         Var : O_Dnode;
         Data : Last_Time_Data;
         Right_Bound : Iir_Int64;
         If_Blk : O_If_Block;
      begin
         Prefix_Type := Get_Type (Prefix);
         Name := Chap6.Translate_Name (Prefix);
         Info := Get_Info (Prefix_Type);
         Var := Create_Temp (Std_Time_Type);

         if Info.Type_Mode in Type_Mode_Scalar then
            New_Assign_Stmt (New_Obj (Var),
                             Read_Last_Time (M2E (Name), Field));
         else
            --  Init with a negative value.
            New_Assign_Stmt (New_Obj (Var),
                             New_Lit (New_Signed_Literal (Std_Time_Type, -1)));
            Data := Last_Time_Data'(Var => Var, Field => Field);
            Translate_Last_Time (Name, Prefix_Type, Data);
         end if;

         Right_Bound := Get_Value
           (Get_Right_Limit (Get_Range_Constraint (Time_Subtype_Definition)));

         --  VAR < 0 ?
         Start_If_Stmt
           (If_Blk,
            New_Compare_Op (ON_Lt,
                            New_Obj_Value (Var),
                            New_Lit (New_Signed_Literal (Std_Time_Type, 0)),
                            Ghdl_Bool_Type));
         --  LRM 14.1 Predefined attributes
         --   [...]; otherwise, it returns TIME'HIGH.
         New_Assign_Stmt (New_Obj (Var),
                          New_Lit (New_Signed_Literal
                                   (Std_Time_Type, Integer_64 (Right_Bound))));
         New_Else_Stmt (If_Blk);
         --  Returns NOW - Var.
         New_Assign_Stmt (New_Obj (Var),
                          New_Dyadic_Op (ON_Sub_Ov,
                                         New_Obj_Value (Ghdl_Now),
                                         New_Obj_Value (Var)));
         Finish_If_Stmt (If_Blk);
         return New_Obj_Value (Var);
      end Translate_Last_Time_Attribute;

      --  Return TRUE if the scalar signal SIG is being driven.
      function Read_Driving_Attribute (Sig : O_Enode) return O_Enode
      is
         Assoc : O_Assoc_List;
      begin
         Start_Association (Assoc, Ghdl_Signal_Driving);
         New_Association (Assoc, New_Convert_Ov (Sig, Ghdl_Signal_Ptr));
         return New_Function_Call (Assoc);
      end Read_Driving_Attribute;

      procedure Driving_Non_Composite_Signal
        (Targ : Mnode; Targ_Type : Iir; Label : O_Snode)
      is
         pragma Unreferenced (Targ_Type);
      begin
         Gen_Exit_When
           (Label,
            New_Monadic_Op
            (ON_Not, Read_Driving_Attribute (New_Value (M2Lv (Targ)))));
      end Driving_Non_Composite_Signal;

      function Driving_Prepare_Data_Composite
        (Targ : Mnode; Targ_Type : Iir; Label : O_Snode)
        return O_Snode
      is
         pragma Unreferenced (Targ, Targ_Type);
      begin
         return Label;
      end Driving_Prepare_Data_Composite;

      function Driving_Update_Data_Array (Label : O_Snode;
                                          Targ_Type : Iir;
                                          Index : O_Dnode)
        return O_Snode
      is
         pragma Unreferenced (Targ_Type, Index);
      begin
         return Label;
      end Driving_Update_Data_Array;

      function Driving_Update_Data_Record (Label : O_Snode;
                                           Targ_Type : Iir;
                                           El : Iir_Element_Declaration)
        return O_Snode
      is
         pragma Unreferenced (Targ_Type, El);
      begin
         return Label;
      end Driving_Update_Data_Record;

      procedure Driving_Finish_Data_Composite (Label : in out O_Snode)
      is
         pragma Unreferenced (Label);
      begin
         null;
      end Driving_Finish_Data_Composite;

      procedure Driving_Foreach is new Foreach_Non_Composite
        (Data_Type => O_Snode,
         Composite_Data_Type => O_Snode,
         Do_Non_Composite => Driving_Non_Composite_Signal,
         Prepare_Data_Array => Driving_Prepare_Data_Composite,
         Update_Data_Array => Driving_Update_Data_Array,
         Finish_Data_Array => Driving_Finish_Data_Composite,
         Prepare_Data_Record => Driving_Prepare_Data_Composite,
         Update_Data_Record => Driving_Update_Data_Record,
         Finish_Data_Record => Driving_Finish_Data_Composite);

      function Translate_Driving_Attribute (Attr : Iir) return O_Enode
      is
         Label : O_Snode;
         Res : O_Dnode;
         Name : Mnode;
         Prefix : Iir;
         Prefix_Type : Iir;
      begin
         Prefix := Get_Prefix (Attr);
         Prefix_Type := Get_Type (Prefix);

         if Get_Kind (Prefix_Type) in Iir_Kinds_Scalar_Type_Definition then
            --  Effecient handling for a scalar signal.
            Name := Chap6.Translate_Name (Prefix);
            return Read_Driving_Attribute (New_Value (M2Lv (Name)));
         else
            --  Element per element handling for composite signals.
            Res := Create_Temp (Std_Boolean_Type_Node);
            Open_Temp;
            New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_False_Node));
            Name := Chap6.Translate_Name (Prefix);
            Start_Loop_Stmt (Label);
            Driving_Foreach (Name, Prefix_Type, Label);
            New_Assign_Stmt (New_Obj (Res), New_Lit (Std_Boolean_True_Node));
            New_Exit_Stmt (Label);
            Finish_Loop_Stmt (Label);
            Close_Temp;
            return New_Obj_Value (Res);
         end if;
      end Translate_Driving_Attribute;

      function Read_Driving_Value (Sig : O_Enode; Sig_Type : Iir)
                                  return O_Enode
      is
         Tinfo : Type_Info_Acc;
         Subprg : O_Dnode;
         Assoc : O_Assoc_List;
      begin
         Tinfo := Get_Info (Sig_Type);
         case Tinfo.Type_Mode is
            when Type_Mode_B2 =>
               Subprg := Ghdl_Signal_Driving_Value_B2;
            when Type_Mode_E8 =>
               Subprg := Ghdl_Signal_Driving_Value_E8;
            when Type_Mode_E32 =>
               Subprg := Ghdl_Signal_Driving_Value_E32;
            when Type_Mode_I32
              | Type_Mode_P32 =>
               Subprg := Ghdl_Signal_Driving_Value_I32;
            when Type_Mode_P64
              | Type_Mode_I64 =>
               Subprg := Ghdl_Signal_Driving_Value_I64;
            when Type_Mode_F64 =>
               Subprg := Ghdl_Signal_Driving_Value_F64;
            when others =>
               raise Internal_Error;
         end case;
         Start_Association (Assoc, Subprg);
         New_Association (Assoc, New_Convert_Ov (Sig, Ghdl_Signal_Ptr));
         return New_Convert_Ov (New_Function_Call (Assoc),
                                Tinfo.Ortho_Type (Mode_Value));
      end Read_Driving_Value;

      function Translate_Driving_Value is new Chap7.Translate_Signal_Value
        (Read_Value => Read_Driving_Value);

      function Translate_Driving_Value_Attribute (Attr : Iir) return O_Enode
      is
         Name : Mnode;
         Prefix : Iir;
         Prefix_Type : Iir;
      begin
         Prefix := Get_Prefix (Attr);
         Prefix_Type := Get_Type (Prefix);

         Name := Chap6.Translate_Name (Prefix);
         if Get_Object_Kind (Name) /= Mode_Signal then
            raise Internal_Error;
         end if;
         return Translate_Driving_Value (M2E (Name), Prefix_Type);
      end Translate_Driving_Value_Attribute;

      function Translate_Image_Attribute (Attr : Iir) return O_Enode
      is
         Prefix_Type : constant Iir :=
           Get_Base_Type (Get_Type (Get_Prefix (Attr)));
         Pinfo : constant Type_Info_Acc := Get_Info (Prefix_Type);
         Res : O_Dnode;
         Subprg : O_Dnode;
         Assoc : O_Assoc_List;
         Conv : O_Tnode;
      begin
         Res := Create_Temp (Std_String_Node);
         Create_Temp_Stack2_Mark;
         case Pinfo.Type_Mode is
            when Type_Mode_B2 =>
               Subprg := Ghdl_Image_B2;
               Conv := Ghdl_Bool_Type;
            when Type_Mode_E8 =>
               Subprg := Ghdl_Image_E8;
               Conv := Ghdl_I32_Type;
            when Type_Mode_E32 =>
               Subprg := Ghdl_Image_E32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_I32 =>
               Subprg := Ghdl_Image_I32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_P32 =>
               Subprg := Ghdl_Image_P32;
               Conv := Ghdl_I32_Type;
            when Type_Mode_P64 =>
               Subprg := Ghdl_Image_P64;
               Conv := Ghdl_I64_Type;
            when Type_Mode_F64 =>
               Subprg := Ghdl_Image_F64;
               Conv := Ghdl_Real_Type;
            when others =>
               raise Internal_Error;
         end case;
         Start_Association (Assoc, Subprg);
         New_Association (Assoc,
                          New_Address (New_Obj (Res), Std_String_Ptr_Node));
         New_Association
           (Assoc,
            New_Convert_Ov
            (Chap7.Translate_Expression (Get_Parameter (Attr), Prefix_Type),
             Conv));
         case Pinfo.Type_Mode is
            when Type_Mode_B2
              | Type_Mode_E8
              | Type_Mode_E32
              | Type_Mode_P32
              | Type_Mode_P64 =>
               New_Association
                 (Assoc, New_Lit (Rtis.New_Rti_Address (Pinfo.Type_Rti)));
            when Type_Mode_I32
              | Type_Mode_F64 =>
               null;
            when others =>
               raise Internal_Error;
         end case;
         New_Procedure_Call (Assoc);
         return New_Address (New_Obj (Res), Std_String_Ptr_Node);
      end Translate_Image_Attribute;

      function Translate_Value_Attribute (Attr : Iir) return O_Enode
      is
         Prefix_Type : constant Iir :=
           Get_Base_Type (Get_Type (Get_Prefix (Attr)));
         Pinfo : constant Type_Info_Acc := Get_Info (Prefix_Type);
         Subprg : O_Dnode;
         Assoc : O_Assoc_List;
      begin
         case Pinfo.Type_Mode is
            when Type_Mode_B2 =>
               Subprg := Ghdl_Value_B2;
            when Type_Mode_E8 =>
               Subprg := Ghdl_Value_E8;
            when Type_Mode_E32 =>
               Subprg := Ghdl_Value_E32;
            when Type_Mode_I32 =>
               Subprg := Ghdl_Value_I32;
            when Type_Mode_P32 =>
               Subprg := Ghdl_Value_P32;
            when Type_Mode_P64 =>
               Subprg := Ghdl_Value_P64;
            when Type_Mode_F64 =>
               Subprg := Ghdl_Value_F64;
            when others =>
               raise Internal_Error;
         end case;
         Start_Association (Assoc, Subprg);
         New_Association
           (Assoc,
            Chap7.Translate_Expression (Get_Parameter (Attr),
                                        String_Type_Definition));
         case Pinfo.Type_Mode is
            when Type_Mode_B2
              | Type_Mode_E8
              | Type_Mode_E32
              | Type_Mode_P32
              | Type_Mode_P64 =>
               New_Association
                 (Assoc, New_Lit (Rtis.New_Rti_Address (Pinfo.Type_Rti)));
            when Type_Mode_I32
              | Type_Mode_F64 =>
               null;
            when others =>
               raise Internal_Error;
         end case;
         return New_Convert_Ov (New_Function_Call (Assoc),
                                Pinfo.Ortho_Type (Mode_Value));
      end Translate_Value_Attribute;

      function Translate_Path_Instance_Name_Attribute (Attr : Iir)
                                                      return O_Enode
      is
         Name : constant Path_Instance_Name_Type :=
           Get_Path_Instance_Name_Suffix (Attr);
         Res : O_Dnode;
         Name_Cst : O_Dnode;
         Str_Cst : O_Cnode;
         Constr : O_Assoc_List;
         Is_Instance : constant Boolean :=
           Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute;
      begin
         Create_Temp_Stack2_Mark;

         Res := Create_Temp (Std_String_Node);
         Str_Cst := Create_String_Len (Name.Suffix, Create_Uniq_Identifier);
         New_Const_Decl (Name_Cst, Create_Uniq_Identifier, O_Storage_Private,
                         Ghdl_Str_Len_Type_Node);
         Start_Const_Value (Name_Cst);
         Finish_Const_Value (Name_Cst, Str_Cst);
         if Is_Instance then
            Start_Association (Constr, Ghdl_Get_Instance_Name);
         else
            Start_Association (Constr, Ghdl_Get_Path_Name);
         end if;
         New_Association
           (Constr, New_Address (New_Obj (Res), Std_String_Ptr_Node));
         if Name.Path_Instance = Null_Iir then
            Rtis.Associate_Null_Rti_Context (Constr);
         else
            Rtis.Associate_Rti_Context (Constr, Name.Path_Instance);
         end if;
         New_Association (Constr,
                          New_Address (New_Obj (Name_Cst),
                                       Ghdl_Str_Len_Ptr_Node));
         New_Procedure_Call (Constr);
         return New_Address (New_Obj (Res), Std_String_Ptr_Node);
      end Translate_Path_Instance_Name_Attribute;
   end Chap14;

   package body Rtis is
      --  Node for package, body, entity, architecture, block, generate,
      --   processes.
      Ghdl_Rtin_Block : O_Tnode;
      Ghdl_Rtin_Block_Common : O_Fnode;
      Ghdl_Rtin_Block_Name : O_Fnode;
      Ghdl_Rtin_Block_Loc : O_Fnode;
      Ghdl_Rtin_Block_Parent : O_Fnode;
      Ghdl_Rtin_Block_Size : O_Fnode;
      Ghdl_Rtin_Block_Nbr_Child : O_Fnode;
      Ghdl_Rtin_Block_Children : O_Fnode;

      --  Node for scalar type decls.
      Ghdl_Rtin_Type_Scalar : O_Tnode;
      Ghdl_Rtin_Type_Scalar_Common : O_Fnode;
      Ghdl_Rtin_Type_Scalar_Name : O_Fnode;

      --  Node for an enumeration type definition.
      Ghdl_Rtin_Type_Enum : O_Tnode;
      Ghdl_Rtin_Type_Enum_Common : O_Fnode;
      Ghdl_Rtin_Type_Enum_Name : O_Fnode;
      Ghdl_Rtin_Type_Enum_Nbr : O_Fnode;
      Ghdl_Rtin_Type_Enum_Lits : O_Fnode;

      --  Node for an unit64.
      Ghdl_Rtin_Unit64 : O_Tnode;
      Ghdl_Rtin_Unit64_Common : O_Fnode;
      Ghdl_Rtin_Unit64_Name : O_Fnode;
      Ghdl_Rtin_Unit64_Value  : O_Fnode;

      --  Node for an unitptr.
      Ghdl_Rtin_Unitptr : O_Tnode;
      Ghdl_Rtin_Unitptr_Common : O_Fnode;
      Ghdl_Rtin_Unitptr_Name : O_Fnode;
      Ghdl_Rtin_Unitptr_Value  : O_Fnode;

      --  Node for a physical type
      Ghdl_Rtin_Type_Physical : O_Tnode;
      Ghdl_Rtin_Type_Physical_Common : O_Fnode;
      Ghdl_Rtin_Type_Physical_Name : O_Fnode;
      Ghdl_Rtin_Type_Physical_Nbr : O_Fnode;
      Ghdl_Rtin_Type_Physical_Units : O_Fnode;

      --  Node for a scalar subtype definition.
      Ghdl_Rtin_Subtype_Scalar : O_Tnode;
      Ghdl_Rtin_Subtype_Scalar_Common : O_Fnode;
      Ghdl_Rtin_Subtype_Scalar_Name : O_Fnode;
      Ghdl_Rtin_Subtype_Scalar_Base : O_Fnode;
      Ghdl_Rtin_Subtype_Scalar_Range : O_Fnode;

      --  Node for an access or a file type.
      Ghdl_Rtin_Type_Fileacc : O_Tnode;
      Ghdl_Rtin_Type_Fileacc_Common : O_Fnode;
      Ghdl_Rtin_Type_Fileacc_Name : O_Fnode;
      Ghdl_Rtin_Type_Fileacc_Base : O_Fnode;

      --  Node for an array type.
      Ghdl_Rtin_Type_Array : O_Tnode;
      Ghdl_Rtin_Type_Array_Common : O_Fnode;
      Ghdl_Rtin_Type_Array_Name : O_Fnode;
      Ghdl_Rtin_Type_Array_Element : O_Fnode;
      Ghdl_Rtin_Type_Array_Nbrdim : O_Fnode;
      Ghdl_Rtin_Type_Array_Indexes : O_Fnode;

      --  Node for an array subtype.
      Ghdl_Rtin_Subtype_Array : O_Tnode;
      Ghdl_Rtin_Subtype_Array_Common : O_Fnode;
      Ghdl_Rtin_Subtype_Array_Name : O_Fnode;
      Ghdl_Rtin_Subtype_Array_Basetype : O_Fnode;
      Ghdl_Rtin_Subtype_Array_Bounds : O_Fnode;
      Ghdl_Rtin_Subtype_Array_Valsize : O_Fnode;
      Ghdl_Rtin_Subtype_Array_Sigsize : O_Fnode;

      --  Node for a record element.
      Ghdl_Rtin_Element : O_Tnode;
      Ghdl_Rtin_Element_Common : O_Fnode;
      Ghdl_Rtin_Element_Name : O_Fnode;
      Ghdl_Rtin_Element_Type : O_Fnode;
      Ghdl_Rtin_Element_Valoff : O_Fnode;
      Ghdl_Rtin_Element_Sigoff : O_Fnode;

      --  Node for a record type.
      Ghdl_Rtin_Type_Record : O_Tnode;
      Ghdl_Rtin_Type_Record_Common : O_Fnode;
      Ghdl_Rtin_Type_Record_Name : O_Fnode;
      Ghdl_Rtin_Type_Record_Nbrel : O_Fnode;
      Ghdl_Rtin_Type_Record_Elements : O_Fnode;
      --Ghdl_Rtin_Type_Record_Valsize : O_Fnode;
      --Ghdl_Rtin_Type_Record_Sigsize : O_Fnode;

      --  Node for an object.
      Ghdl_Rtin_Object : O_Tnode;
      Ghdl_Rtin_Object_Common : O_Fnode;
      Ghdl_Rtin_Object_Name : O_Fnode;
      Ghdl_Rtin_Object_Loc : O_Fnode;
      Ghdl_Rtin_Object_Type : O_Fnode;

      --  Node for an instance.
      Ghdl_Rtin_Instance : O_Tnode;
      Ghdl_Rtin_Instance_Common : O_Fnode;
      Ghdl_Rtin_Instance_Name : O_Fnode;
      Ghdl_Rtin_Instance_Loc : O_Fnode;
      Ghdl_Rtin_Instance_Parent : O_Fnode;
      Ghdl_Rtin_Instance_Type : O_Fnode;

      --  Node for a component.
      Ghdl_Rtin_Component : O_Tnode;
      Ghdl_Rtin_Component_Common : O_Fnode;
      Ghdl_Rtin_Component_Name : O_Fnode;
      Ghdl_Rtin_Component_Nbr_Child : O_Fnode;
      Ghdl_Rtin_Component_Children : O_Fnode;

      procedure Rti_Initialize
      is
      begin
         --  Create type ghdl_rti_kind is (ghdl_rtik_typedef_bool, ...)
         declare
            Constr : O_Enum_List;
         begin
            Start_Enum_Type (Constr, 8);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_top"),
               Ghdl_Rtik_Top);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_library"),
               Ghdl_Rtik_Library);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_package"),
               Ghdl_Rtik_Package);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_package_body"),
               Ghdl_Rtik_Package_Body);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_entity"),
               Ghdl_Rtik_Entity);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_architecture"),
               Ghdl_Rtik_Architecture);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_process"),
               Ghdl_Rtik_Process);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_block"),
               Ghdl_Rtik_Block);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_if_generate"),
               Ghdl_Rtik_If_Generate);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_for_generate"),
               Ghdl_Rtik_For_Generate);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_instance"),
               Ghdl_Rtik_Instance);

            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_constant"),
               Ghdl_Rtik_Constant);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_iterator"),
               Ghdl_Rtik_Iterator);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_variable"),
               Ghdl_Rtik_Variable);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_signal"),
               Ghdl_Rtik_Signal);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_file"),
               Ghdl_Rtik_File);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_port"),
               Ghdl_Rtik_Port);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_generic"),
               Ghdl_Rtik_Generic);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_alias"),
               Ghdl_Rtik_Alias);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_guard"),
               Ghdl_Rtik_Guard);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_component"),
               Ghdl_Rtik_Component);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_attribute"),
               Ghdl_Rtik_Attribute);

            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_b2"),
               Ghdl_Rtik_Type_B2);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_e8"),
               Ghdl_Rtik_Type_E8);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_e32"),
               Ghdl_Rtik_Type_E32);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_i32"),
               Ghdl_Rtik_Type_I32);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_i64"),
               Ghdl_Rtik_Type_I64);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_f64"),
               Ghdl_Rtik_Type_F64);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_p32"),
               Ghdl_Rtik_Type_P32);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_p64"),
               Ghdl_Rtik_Type_P64);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_access"),
               Ghdl_Rtik_Type_Access);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_array"),
               Ghdl_Rtik_Type_Array);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_record"),
               Ghdl_Rtik_Type_Record);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_file"),
               Ghdl_Rtik_Type_File);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_subtype_scalar"),
               Ghdl_Rtik_Subtype_Scalar);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_subtype_array"),
               Ghdl_Rtik_Subtype_Array);
            New_Enum_Literal
              (Constr,
               Get_Identifier ("__ghdl_rtik_subtype_unconstrained_array"),
               Ghdl_Rtik_Subtype_Unconstrained_Array);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_subtype_record"),
               Ghdl_Rtik_Subtype_Record);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_subtype_access"),
               Ghdl_Rtik_Subtype_Access);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_type_protected"),
               Ghdl_Rtik_Type_Protected);

            New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_element"),
                              Ghdl_Rtik_Element);
            New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_unit64"),
                              Ghdl_Rtik_Unit64);
            New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_unitptr"),
                              Ghdl_Rtik_Unitptr);

            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_attribute_transaction"),
               Ghdl_Rtik_Attribute_Transaction);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_attribute_quiet"),
               Ghdl_Rtik_Attribute_Quiet);
            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_attribute_stable"),
               Ghdl_Rtik_Attribute_Stable);

            New_Enum_Literal
              (Constr, Get_Identifier ("__ghdl_rtik_psl_assert"),
               Ghdl_Rtik_Psl_Assert);

            New_Enum_Literal (Constr, Get_Identifier ("__ghdl_rtik_error"),
                              Ghdl_Rtik_Error);
            Finish_Enum_Type (Constr, Ghdl_Rtik);
            New_Type_Decl (Get_Identifier ("__ghdl_rtik"), Ghdl_Rtik);
         end;

         --  Create type ghdl_rti_depth.
         Ghdl_Rti_Depth := New_Unsigned_Type (8);
         New_Type_Decl (Get_Identifier ("__ghdl_rti_depth"), Ghdl_Rti_Depth);
         Ghdl_Rti_U8 := New_Unsigned_Type (8);
         New_Type_Decl (Get_Identifier ("__ghdl_rti_u8"), Ghdl_Rti_U8);

         --  Create type ghdl_rti_common.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rti_Common_Kind,
                              Get_Identifier ("kind"), Ghdl_Rtik);
            New_Record_Field (Constr, Ghdl_Rti_Common_Depth,
                              Get_Identifier ("depth"), Ghdl_Rti_Depth);
            New_Record_Field (Constr, Ghdl_Rti_Common_Mode,
                              Get_Identifier ("mode"), Ghdl_Rti_U8);
            New_Record_Field (Constr, Ghdl_Rti_Common_Max_Depth,
                              Get_Identifier ("max_depth"), Ghdl_Rti_Depth);
            Finish_Record_Type (Constr, Ghdl_Rti_Common);
            New_Type_Decl (Get_Identifier ("__ghdl_rti_common"),
                           Ghdl_Rti_Common);
         end;

         Ghdl_Rti_Access := New_Access_Type (Ghdl_Rti_Common);
         New_Type_Decl (Get_Identifier ("__ghdl_rti_access"), Ghdl_Rti_Access);

         Ghdl_Rti_Array := New_Array_Type (Ghdl_Rti_Access, Ghdl_Index_Type);
         New_Type_Decl (Get_Identifier ("__ghdl_rti_array"), Ghdl_Rti_Array);

         Ghdl_Rti_Arr_Acc := New_Access_Type (Ghdl_Rti_Array);
         New_Type_Decl (Get_Identifier ("__ghdl_rti_arr_acc"),
                        Ghdl_Rti_Arr_Acc);

         --  Ghdl_Component_Link_Type.
         New_Uncomplete_Record_Type (Ghdl_Component_Link_Type);
         New_Type_Decl (Get_Identifier ("__ghdl_component_link_type"),
                        Ghdl_Component_Link_Type);

         Ghdl_Component_Link_Acc := New_Access_Type (Ghdl_Component_Link_Type);
         New_Type_Decl (Get_Identifier ("__ghdl_component_link_acc"),
                        Ghdl_Component_Link_Acc);

         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Entity_Link_Rti,
                              Get_Identifier ("rti"), Ghdl_Rti_Access);
            New_Record_Field (Constr, Ghdl_Entity_Link_Parent,
                              Wki_Parent, Ghdl_Component_Link_Acc);
            Finish_Record_Type (Constr, Ghdl_Entity_Link_Type);
            New_Type_Decl (Get_Identifier ("__ghdl_entity_link_type"),
                           Ghdl_Entity_Link_Type);
         end;

         Ghdl_Entity_Link_Acc := New_Access_Type (Ghdl_Entity_Link_Type);
         New_Type_Decl (Get_Identifier ("__ghdl_entity_link_acc"),
                        Ghdl_Entity_Link_Acc);

         declare
            Constr : O_Element_List;
         begin
            Start_Uncomplete_Record_Type (Ghdl_Component_Link_Type, Constr);
            New_Record_Field (Constr, Ghdl_Component_Link_Instance,
                              Wki_Instance, Ghdl_Entity_Link_Acc);
            New_Record_Field (Constr, Ghdl_Component_Link_Stmt,
                              Get_Identifier ("stmt"), Ghdl_Rti_Access);
            Finish_Record_Type (Constr, Ghdl_Component_Link_Type);
         end;

         --  Create type ghdl_rtin_block
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Block_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Block_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Block_Loc,
                              Get_Identifier ("loc"), Ghdl_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Block_Parent,
                              Wki_Parent, Ghdl_Rti_Access);
            New_Record_Field (Constr, Ghdl_Rtin_Block_Size,
                              Get_Identifier ("size"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Block_Nbr_Child,
                              Get_Identifier ("nbr_child"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Block_Children,
                              Get_Identifier ("children"), Ghdl_Rti_Arr_Acc);
            Finish_Record_Type (Constr, Ghdl_Rtin_Block);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_block"),
                           Ghdl_Rtin_Block);
         end;

         --  type (type and subtype declarations).
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Scalar_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Scalar_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            Finish_Record_Type (Constr, Ghdl_Rtin_Type_Scalar);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_type_scalar"),
                           Ghdl_Rtin_Type_Scalar);
         end;

         --  Type_Enum
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Enum_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Enum_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Enum_Nbr,
                              Get_Identifier ("nbr"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Enum_Lits,
                              Get_Identifier ("lits"),
                              Char_Ptr_Array_Ptr_Type);
            Finish_Record_Type (Constr, Ghdl_Rtin_Type_Enum);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_type_enum"),
                           Ghdl_Rtin_Type_Enum);
         end;

         --  subtype_scalar
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Scalar_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Scalar_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Scalar_Base,
                              Get_Identifier ("base"), Ghdl_Rti_Access);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Scalar_Range,
                              Get_Identifier ("range"), Ghdl_Ptr_Type);
            Finish_Record_Type (Constr, Ghdl_Rtin_Subtype_Scalar);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_subtype_scalar"),
                           Ghdl_Rtin_Subtype_Scalar);
         end;

         --  Unit64
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Unit64_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Unit64_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Unit64_Value,
                              Get_Identifier ("value"), Ghdl_I64_Type);
            Finish_Record_Type (Constr, Ghdl_Rtin_Unit64);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_unit64"),
                           Ghdl_Rtin_Unit64);
         end;

         --  Unitptr
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Unitptr_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Unitptr_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Unitptr_Value,
                              Get_Identifier ("addr"), Ghdl_Ptr_Type);
            Finish_Record_Type (Constr, Ghdl_Rtin_Unitptr);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_unitptr"),
                           Ghdl_Rtin_Unitptr);
         end;

         --  Physical type.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Physical_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Physical_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Physical_Nbr,
                              Get_Identifier ("nbr"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Physical_Units,
                              Get_Identifier ("units"), Ghdl_Rti_Arr_Acc);
            Finish_Record_Type (Constr, Ghdl_Rtin_Type_Physical);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_type_physical"),
                           Ghdl_Rtin_Type_Physical);
         end;

         --  file and access type.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Fileacc_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Fileacc_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Fileacc_Base,
                              Get_Identifier ("base"), Ghdl_Rti_Access);
            Finish_Record_Type (Constr, Ghdl_Rtin_Type_Fileacc);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_type_fileacc"),
                           Ghdl_Rtin_Type_Fileacc);
         end;

         --  arraytype.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Array_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Array_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Array_Element,
                              Get_Identifier ("element"), Ghdl_Rti_Access);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Array_Nbrdim,
                              Get_Identifier ("nbr_dim"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Array_Indexes,
                              Get_Identifier ("indexes"), Ghdl_Rti_Arr_Acc);
            Finish_Record_Type (Constr, Ghdl_Rtin_Type_Array);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_type_array"),
                           Ghdl_Rtin_Type_Array);
         end;

         --  subtype_Array.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Basetype,
                              Get_Identifier ("basetype"), Ghdl_Rti_Access);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Bounds,
                              Get_Identifier ("bounds"), Ghdl_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Valsize,
                              Get_Identifier ("val_size"), Ghdl_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Subtype_Array_Sigsize,
                              Get_Identifier ("sig_size"), Ghdl_Ptr_Type);
            Finish_Record_Type (Constr, Ghdl_Rtin_Subtype_Array);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_subtype_array"),
                           Ghdl_Rtin_Subtype_Array);
         end;

         --  type record.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Nbrel,
                              Get_Identifier ("nbrel"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Type_Record_Elements,
                              Get_Identifier ("elements"), Ghdl_Rti_Arr_Acc);
            Finish_Record_Type (Constr, Ghdl_Rtin_Type_Record);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_type_record"),
                           Ghdl_Rtin_Type_Record);
         end;

         --  record element.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Element_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Element_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Element_Type,
                              Get_Identifier ("eltype"), Ghdl_Rti_Access);
            New_Record_Field (Constr, Ghdl_Rtin_Element_Valoff,
                              Get_Identifier ("val_off"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Element_Sigoff,
                              Get_Identifier ("sig_off"), Ghdl_Index_Type);
            Finish_Record_Type (Constr, Ghdl_Rtin_Element);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_element"),
                           Ghdl_Rtin_Element);
         end;

         --  Object.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Object_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Object_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Object_Loc,
                              Get_Identifier ("loc"), Ghdl_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Object_Type,
                              Get_Identifier ("obj_type"), Ghdl_Rti_Access);
            Finish_Record_Type (Constr, Ghdl_Rtin_Object);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_object"),
                           Ghdl_Rtin_Object);
         end;

         --  Instance.
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Instance_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Instance_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Instance_Loc,
                              Get_Identifier ("loc"), Ghdl_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Instance_Parent,
                              Wki_Parent, Ghdl_Rti_Access);
            New_Record_Field (Constr, Ghdl_Rtin_Instance_Type,
                              Get_Identifier ("instance"), Ghdl_Rti_Access);
            Finish_Record_Type (Constr, Ghdl_Rtin_Instance);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_instance"),
                           Ghdl_Rtin_Instance);
         end;

         --  Component
         declare
            Constr : O_Element_List;
         begin
            Start_Record_Type (Constr);
            New_Record_Field (Constr, Ghdl_Rtin_Component_Common,
                              Get_Identifier ("common"), Ghdl_Rti_Common);
            New_Record_Field (Constr, Ghdl_Rtin_Component_Name,
                              Get_Identifier ("name"), Char_Ptr_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Component_Nbr_Child,
                              Get_Identifier ("nbr_child"), Ghdl_Index_Type);
            New_Record_Field (Constr, Ghdl_Rtin_Component_Children,
                              Get_Identifier ("children"), Ghdl_Rti_Arr_Acc);
            Finish_Record_Type (Constr, Ghdl_Rtin_Component);
            New_Type_Decl (Get_Identifier ("__ghdl_rtin_component"),
                           Ghdl_Rtin_Component);
         end;

      end Rti_Initialize;

      type Rti_Array is array (1 .. 8) of O_Dnode;
      type Rti_Array_List;
      type Rti_Array_List_Acc is access Rti_Array_List;
      type Rti_Array_List is record
         Rtis : Rti_Array;
         Next : Rti_Array_List_Acc;
      end record;

      type Rti_Block is record
         Depth : Rti_Depth_Type;
         Nbr : Integer;
         List : Rti_Array_List;
         Last_List : Rti_Array_List_Acc;
         Last_Nbr : Integer;
      end record;

      Cur_Block : Rti_Block := (Depth => 0,
                                Nbr => 0,
                                List => (Rtis => (others => O_Dnode_Null),
                                         Next => null),
                                Last_List => null,
                                Last_Nbr => 0);

      Free_List : Rti_Array_List_Acc := null;

      procedure Push_Rti_Node (Prev : out Rti_Block; Deeper : Boolean := True)
      is
         Ndepth : Rti_Depth_Type;
      begin
         if Deeper then
            Ndepth := Cur_Block.Depth + 1;
         else
            Ndepth := Cur_Block.Depth;
         end if;
         Prev := Cur_Block;
         Cur_Block := (Depth => Ndepth,
                       Nbr => 0,
                       List => (Rtis => (others => O_Dnode_Null),
                                Next => null),
                       Last_List => null,
                       Last_Nbr => 0);
      end Push_Rti_Node;

      procedure Add_Rti_Node (Node : O_Dnode)
      is
      begin
         if Node = O_Dnode_Null then
            --  FIXME: temporary for not yet handled types.
            return;
         end if;
         if Cur_Block.Last_Nbr = Rti_Array'Last then
            declare
               N : Rti_Array_List_Acc;
            begin
               if Free_List = null then
                  N := new Rti_Array_List;
               else
                  N := Free_List;
                  Free_List := N.Next;
               end if;
               N.Next := null;
               if Cur_Block.Last_List = null then
                  Cur_Block.List.Next := N;
               else
                  Cur_Block.Last_List.Next := N;
               end if;
               Cur_Block.Last_List := N;
            end;
            Cur_Block.Last_Nbr := 1;
         else
            Cur_Block.Last_Nbr := Cur_Block.Last_Nbr + 1;
         end if;
         if Cur_Block.Last_List = null then
            Cur_Block.List.Rtis (Cur_Block.Last_Nbr) := Node;
         else
            Cur_Block.Last_List.Rtis (Cur_Block.Last_Nbr) := Node;
         end if;
         Cur_Block.Nbr := Cur_Block.Nbr + 1;
      end Add_Rti_Node;

      function Generate_Rti_Array (Id : O_Ident) return O_Dnode
      is
         Arr_Type : O_Tnode;
         List : O_Array_Aggr_List;
         L : Rti_Array_List_Acc;
         Nbr : Integer;
         Val : O_Cnode;
         Res : O_Dnode;
      begin
         Arr_Type := New_Constrained_Array_Type
           (Ghdl_Rti_Array,
            New_Unsigned_Literal (Ghdl_Index_Type,
                                  Unsigned_64 (Cur_Block.Nbr + 1)));
         New_Const_Decl (Res, Id, O_Storage_Private, Arr_Type);
         Start_Const_Value (Res);
         Start_Array_Aggr (List, Arr_Type);
         Nbr := Cur_Block.Nbr;
         for I in Cur_Block.List.Rtis'Range loop
            exit when I > Nbr;
            New_Array_Aggr_El
              (List, New_Global_Unchecked_Address (Cur_Block.List.Rtis (I),
                                                   Ghdl_Rti_Access));
         end loop;
         L := Cur_Block.List.Next;
         while L /= null loop
            Nbr := Nbr - Cur_Block.List.Rtis'Length;
            for I in L.Rtis'Range loop
               exit when I > Nbr;
               New_Array_Aggr_El
                 (List, New_Global_Unchecked_Address (L.Rtis (I),
                                                      Ghdl_Rti_Access));
            end loop;
            L := L.Next;
         end loop;
         New_Array_Aggr_El (List, New_Null_Access (Ghdl_Rti_Access));
         Finish_Array_Aggr (List, Val);
         Finish_Const_Value (Res, Val);
         return Res;
      end Generate_Rti_Array;

      procedure Pop_Rti_Node (Prev : Rti_Block)
      is
         L : Rti_Array_List_Acc;
      begin
         L := Cur_Block.List.Next;
         if L /= null then
            Cur_Block.Last_List.Next := Free_List;
            Free_List := Cur_Block.List.Next;
            Cur_Block.List.Next := null;
         end if;
         Cur_Block := Prev;
      end Pop_Rti_Node;

      function Get_Depth_From_Var (Var : Var_Acc := null) return Rti_Depth_Type
      is
      begin
         if Var = null or else Is_Var_Field (Var) then
            return Cur_Block.Depth;
         else
            return 0;
         end if;
      end Get_Depth_From_Var;

      function Generate_Common
        (Kind : O_Cnode; Var : Var_Acc := null; Mode : Natural := 0)
        return O_Cnode
      is
         List : O_Record_Aggr_List;
         Res : O_Cnode;
         Val : Unsigned_64;
      begin
         Start_Record_Aggr (List, Ghdl_Rti_Common);
         New_Record_Aggr_El (List, Kind);
         Val := Unsigned_64 (Get_Depth_From_Var (Var));
         New_Record_Aggr_El (List, New_Unsigned_Literal (Ghdl_Rti_Depth, Val));
         New_Record_Aggr_El
           (List, New_Unsigned_Literal (Ghdl_Rti_U8, Unsigned_64 (Mode)));
         New_Record_Aggr_El (List, New_Unsigned_Literal (Ghdl_Rti_Depth, 0));
         Finish_Record_Aggr (List, Res);
         return Res;
      end Generate_Common;

      --  Same as Generat_Common but for types.
      function Generate_Common_Type (Kind : O_Cnode;
                                     Depth : Rti_Depth_Type;
                                     Max_Depth : Rti_Depth_Type;
                                     Mode : Natural := 0)
                                    return O_Cnode
      is
         List : O_Record_Aggr_List;
         Res : O_Cnode;
      begin
         Start_Record_Aggr (List, Ghdl_Rti_Common);
         New_Record_Aggr_El (List, Kind);
         New_Record_Aggr_El
           (List,
            New_Unsigned_Literal (Ghdl_Rti_Depth, Unsigned_64 (Depth)));
         New_Record_Aggr_El
           (List, New_Unsigned_Literal (Ghdl_Rti_U8, Unsigned_64 (Mode)));
         New_Record_Aggr_El
           (List,
            New_Unsigned_Literal (Ghdl_Rti_Depth, Unsigned_64 (Max_Depth)));
         Finish_Record_Aggr (List, Res);
         return Res;
      end Generate_Common_Type;

      function Generate_Name (Node : Iir) return O_Dnode
      is
         use Name_Table;
         Id : Name_Id;
      begin
         Id := Get_Identifier (Node);
         if Is_Character (Id) then
            Name_Buffer (1) := ''';
            Name_Buffer (2) := Get_Character (Id);
            Name_Buffer (3) := ''';
            Name_Length := 3;
         else
            Image (Id);
         end if;
         return Create_String (Name_Buffer (1 .. Name_Length),
                               Create_Identifier ("RTISTR"));
      end Generate_Name;

      function Get_Null_Loc return O_Cnode is
      begin
         return New_Null_Access (Ghdl_Ptr_Type);
      end Get_Null_Loc;

      function Var_Acc_To_Loc (Var : Var_Acc) return O_Cnode
      is
      begin
         if Is_Var_Field (Var) then
            return New_Offsetof (Get_Var_Record (Var),
                                 Get_Var_Field (Var),
                                 Ghdl_Ptr_Type);
         else
            return New_Global_Unchecked_Address (Get_Var_Label (Var),
                                                 Ghdl_Ptr_Type);
         end if;
      end Var_Acc_To_Loc;

      --  Generate a name constant for the name of type definition DEF.
      --  If DEF is an anonymous subtype, returns O_LNODE_NULL.
      --  Use function NEW_NAME_ADDRESS (defined below) to convert the
      --  result into an address expression.
      function Generate_Type_Name (Def : Iir) return O_Dnode
      is
         Decl : Iir;
      begin
         Decl := Get_Type_Declarator (Def);
         if Decl /= Null_Iir then
            return Generate_Name (Decl);
         else
            return O_Dnode_Null;
         end if;
      end Generate_Type_Name;

      --  Convert a name constant NAME into an address.
      --  If NAME is O_LNODE_NULL, return a null address.
      --  To be used with GENERATE_TYPE_NAME.
      function New_Name_Address (Name : O_Dnode) return O_Cnode
      is
      begin
         if Name = O_Dnode_Null then
            return New_Null_Access (Char_Ptr_Type);
         else
            return New_Global_Unchecked_Address (Name, Char_Ptr_Type);
         end if;
      end New_Name_Address;

      function New_Rti_Address (Rti : O_Dnode) return O_Cnode is
      begin
         return New_Global_Unchecked_Address (Rti, Ghdl_Rti_Access);
      end New_Rti_Address;

      --  Declare the RTI constant for type definition attached to INFO.
      --  The only feature is not to declare it if it was already declared.
      --  (due to an incomplete type declaration).
      procedure Generate_Type_Rti (Info : Type_Info_Acc; Rti_Type : O_Tnode)
      is
      begin
         if Info.Type_Rti = O_Dnode_Null then
            New_Const_Decl (Info.Type_Rti, Create_Identifier ("RTI"),
                            Global_Storage, Rti_Type);
         end if;
      end Generate_Type_Rti;

      function Generate_Type_Definition (Atype : Iir; Force : Boolean := False)
                                        return O_Dnode;

      procedure Generate_Enumeration_Type_Definition (Atype : Iir)
      is
         Val : O_Cnode;
         Info : Type_Info_Acc;
      begin
         Info := Get_Info (Atype);
         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Enum);
         Info.T.Rti_Max_Depth := 0;

         if Global_Storage = O_Storage_External then
            return;
         end if;

         declare
            Lit_List : constant Iir_List :=
              Get_Enumeration_Literal_List (Atype);
            Nbr_Lit : constant Integer := Get_Nbr_Elements (Lit_List);
            Lit : Iir;

            type Dnode_Array is array (Natural range <>) of O_Dnode;
            Name_Lits : Dnode_Array (0 .. Nbr_Lit - 1);
            Mark : Id_Mark_Type;
            Name_Arr_Type : O_Tnode;
            Name_Arr : O_Dnode;

            Arr_Aggr : O_Array_Aggr_List;
            Rec_Aggr : O_Record_Aggr_List;
            Kind : O_Cnode;
            Name : O_Dnode;
         begin
            --  Generate name for each literal.
            for I in Name_Lits'Range loop
               Lit := Get_Nth_Element (Lit_List, I);
               Push_Identifier_Prefix (Mark, Get_Identifier (Lit));
               Name_Lits (I) := Generate_Name (Lit);
               Pop_Identifier_Prefix (Mark);
            end loop;

            --  Generate array of names.
            Name_Arr_Type := New_Constrained_Array_Type
              (Char_Ptr_Array_Type,
               New_Unsigned_Literal (Ghdl_Index_Type,
                                     Unsigned_64 (Nbr_Lit)));
            New_Const_Decl (Name_Arr, Create_Identifier ("RTINAMES"),
                            O_Storage_Private, Name_Arr_Type);
            Start_Const_Value (Name_Arr);
            Start_Array_Aggr (Arr_Aggr, Name_Arr_Type);
            for I in Name_Lits'Range loop
               New_Array_Aggr_El
                 (Arr_Aggr, New_Global_Address (Name_Lits (I), Char_Ptr_Type));
            end loop;
            Finish_Array_Aggr (Arr_Aggr, Val);
            Finish_Const_Value (Name_Arr, Val);

            Name := Generate_Type_Name (Atype);

            Start_Const_Value (Info.Type_Rti);
            case Info.Type_Mode is
               when Type_Mode_B2 =>
                  Kind := Ghdl_Rtik_Type_B2;
               when Type_Mode_E8 =>
                  Kind := Ghdl_Rtik_Type_E8;
               when Type_Mode_E32 =>
                  Kind := Ghdl_Rtik_Type_E32;
               when others =>
                  raise Internal_Error;
            end case;
            Start_Record_Aggr (Rec_Aggr, Ghdl_Rtin_Type_Enum);
            New_Record_Aggr_El (Rec_Aggr, Generate_Common_Type (Kind, 0, 0));
            New_Record_Aggr_El (Rec_Aggr, New_Name_Address (Name));
            New_Record_Aggr_El
              (Rec_Aggr, New_Unsigned_Literal (Ghdl_Index_Type,
                                               Unsigned_64 (Nbr_Lit)));
            New_Record_Aggr_El
              (Rec_Aggr,
               New_Global_Address (Name_Arr, Char_Ptr_Array_Ptr_Type));
            Finish_Record_Aggr (Rec_Aggr, Val);
            Finish_Const_Value (Info.Type_Rti, Val);
         end;
      end Generate_Enumeration_Type_Definition;

      procedure Generate_Scalar_Type_Definition (Atype : Iir; Name : O_Dnode)
      is
         Info : Type_Info_Acc;
         Kind : O_Cnode;
         Val : O_Cnode;
         List : O_Record_Aggr_List;
      begin
         Info := Get_Info (Atype);

         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Scalar);
         Info.T.Rti_Max_Depth := 0;

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Start_Const_Value (Info.Type_Rti);
         case Info.Type_Mode is
            when Type_Mode_I32 =>
               Kind := Ghdl_Rtik_Type_I32;
            when Type_Mode_I64 =>
               Kind := Ghdl_Rtik_Type_I64;
            when Type_Mode_F64 =>
               Kind := Ghdl_Rtik_Type_F64;
            when Type_Mode_P64 =>
               Kind := Ghdl_Rtik_Type_P64;
            when others =>
               Error_Kind ("generate_scalar_type_definition", Atype);
         end case;
         Start_Record_Aggr (List, Ghdl_Rtin_Type_Scalar);
         New_Record_Aggr_El (List, Generate_Common_Type (Kind, 0, 0));
         New_Record_Aggr_El (List, New_Name_Address (Name));
         Finish_Record_Aggr (List, Val);
         Finish_Const_Value (Info.Type_Rti, Val);
      end Generate_Scalar_Type_Definition;

      procedure Generate_Unit_Declaration (Unit : Iir_Unit_Declaration)
      is
         Name : O_Dnode;
         Mark : Id_Mark_Type;
         Aggr : O_Record_Aggr_List;
         Val : O_Cnode;
         Const : O_Dnode;
         Info : constant Object_Info_Acc := Get_Info (Unit);
         Rti_Type : O_Tnode;
         Rtik : O_Cnode;
      begin
         Push_Identifier_Prefix (Mark, Get_Identifier (Unit));
         Name := Generate_Name (Unit);
         if Info /= null then
            --  Non-static units.  The only possibility is a unit of
            --  std.standard.time.
            Rti_Type := Ghdl_Rtin_Unitptr;
            Rtik := Ghdl_Rtik_Unitptr;
         else
            Rti_Type := Ghdl_Rtin_Unit64;
            Rtik := Ghdl_Rtik_Unit64;
         end if;
         New_Const_Decl (Const, Create_Identifier ("RTI"),
                         Global_Storage, Rti_Type);
         Start_Const_Value (Const);
         Start_Record_Aggr (Aggr, Rti_Type);
         New_Record_Aggr_El (Aggr, Generate_Common (Rtik));
         New_Record_Aggr_El (Aggr, New_Name_Address (Name));
         if Info /= null then
            --  Handle non-static units.  The only possibility is a unit of
            --  std.standard.time.
            Val := New_Global_Unchecked_Address
              (Get_Var_Label (Info.Object_Var), Ghdl_Ptr_Type);
         else
            Val := Chap7.Translate_Numeric_Literal (Unit, Ghdl_I64_Type);
         end if;
         New_Record_Aggr_El (Aggr, Val);
         Finish_Record_Aggr (Aggr, Val);
         Finish_Const_Value (Const, Val);
         Add_Rti_Node (Const);
         Pop_Identifier_Prefix (Mark);
      end Generate_Unit_Declaration;

      procedure Generate_Physical_Type_Definition (Atype : Iir; Name : O_Dnode)
      is
         Info : Type_Info_Acc;
         Val : O_Cnode;
         List : O_Record_Aggr_List;
         Prev : Rti_Block;
         Unit : Iir_Unit_Declaration;
         Nbr_Units : Integer;
         Unit_Arr : O_Dnode;
         Rti_Kind : O_Cnode;
      begin
         Info := Get_Info (Atype);

         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Physical);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Push_Rti_Node (Prev, False);
         Unit := Get_Unit_Chain (Atype);
         Nbr_Units := 0;
         while Unit /= Null_Iir loop
            Generate_Unit_Declaration (Unit);
            Nbr_Units := Nbr_Units + 1;
            Unit := Get_Chain (Unit);
         end loop;
         Unit_Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));
         Pop_Rti_Node (Prev);

         Start_Const_Value (Info.Type_Rti);
         Start_Record_Aggr (List, Ghdl_Rtin_Type_Physical);
         case Info.Type_Mode is
            when Type_Mode_P64 =>
               Rti_Kind := Ghdl_Rtik_Type_P64;
            when Type_Mode_P32 =>
               Rti_Kind := Ghdl_Rtik_Type_P32;
            when others =>
               raise Internal_Error;
         end case;
         New_Record_Aggr_El (List, Generate_Common_Type (Rti_Kind, 0, 0, 0));
         New_Record_Aggr_El (List, New_Name_Address (Name));
         New_Record_Aggr_El
           (List,
            New_Unsigned_Literal (Ghdl_Index_Type,
                                  Unsigned_64 (Nbr_Units)));
         New_Record_Aggr_El
           (List, New_Global_Address (Unit_Arr, Ghdl_Rti_Arr_Acc));
         Finish_Record_Aggr (List, Val);
         Finish_Const_Value (Info.Type_Rti, Val);
      end Generate_Physical_Type_Definition;

      procedure Generate_Scalar_Subtype_Definition (Atype : Iir)
      is
         Base_Type : Iir;
         Base_Info : Type_Info_Acc;
         Info : Type_Info_Acc;
         Aggr : O_Record_Aggr_List;
         Val : O_Cnode;
         Name : O_Dnode;
      begin
         Info := Get_Info (Atype);

         if Global_Storage = O_Storage_External then
            Name := O_Dnode_Null;
         else
            Name := Generate_Type_Name (Atype);
         end if;

         --  Generate base type definition, if necessary.
         --  (do it even in packages).
         Base_Type := Get_Base_Type (Atype);
         Base_Info := Get_Info (Base_Type);
         if Base_Info.Type_Rti = O_Dnode_Null then
            declare
               Mark : Id_Mark_Type;
            begin
               Push_Identifier_Prefix (Mark, "BT");
               if Get_Kind (Base_Type) = Iir_Kind_Physical_Type_Definition then
                  Generate_Physical_Type_Definition (Base_Type, Name);
               else
                  Generate_Scalar_Type_Definition (Base_Type, Name);
               end if;
               Pop_Identifier_Prefix (Mark);
            end;
         end if;

         Generate_Type_Rti (Info, Ghdl_Rtin_Subtype_Scalar);
         Info.T.Rti_Max_Depth := Get_Depth_From_Var (Info.T.Range_Var);
         if Global_Storage = O_Storage_External then
            return;
         end if;

         Start_Const_Value (Info.Type_Rti);
         Start_Record_Aggr (Aggr, Ghdl_Rtin_Subtype_Scalar);
         New_Record_Aggr_El
           (Aggr, Generate_Common_Type (Ghdl_Rtik_Subtype_Scalar,
                                        Info.T.Rti_Max_Depth,
                                        Info.T.Rti_Max_Depth));

         New_Record_Aggr_El (Aggr, New_Name_Address (Name));
         New_Record_Aggr_El (Aggr, New_Rti_Address (Base_Info.Type_Rti));
         New_Record_Aggr_El (Aggr, Var_Acc_To_Loc (Info.T.Range_Var));
         Finish_Record_Aggr (Aggr, Val);
         Finish_Const_Value (Info.Type_Rti, Val);
      end Generate_Scalar_Subtype_Definition;

      procedure Generate_Fileacc_Type_Definition (Atype : Iir)
      is
         Info : Type_Info_Acc;
         Kind : O_Cnode;
         Val : O_Cnode;
         List : O_Record_Aggr_List;
         Name : O_Dnode;
         Base : O_Dnode;
         Base_Type : Iir;
      begin
         Info := Get_Info (Atype);

         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Fileacc);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         case Get_Kind (Atype) is
            when Iir_Kind_Access_Type_Definition =>
               declare
                  Mark : Id_Mark_Type;
               begin
                  Push_Identifier_Prefix (Mark, "AT");
                  Base := Generate_Type_Definition
                    (Get_Designated_Type (Atype));
                  Pop_Identifier_Prefix (Mark);
               end;
               if Get_Kind (Atype) = Iir_Kind_Access_Subtype_Definition then
                  Kind := Ghdl_Rtik_Subtype_Access;
               else
                  Kind := Ghdl_Rtik_Type_Access;
               end if;
               --  Don't bother with designated type.  This at least avoid
               --  loops.
               Base_Type := Null_Iir;
            when Iir_Kind_File_Type_Definition =>
               Base_Type := Get_Type (Get_File_Type_Mark (Atype));
               Base := Generate_Type_Definition (Base_Type);
               Kind := Ghdl_Rtik_Type_File;
            when Iir_Kind_Record_Subtype_Definition =>
               Base_Type := Get_Base_Type (Atype);
               Base := Get_Info (Base_Type).Type_Rti;
               Kind := Ghdl_Rtik_Subtype_Record;
            when Iir_Kind_Access_Subtype_Definition =>
               Base_Type := Get_Base_Type (Atype);
               Base := Get_Info (Base_Type).Type_Rti;
               Kind := Ghdl_Rtik_Subtype_Access;
            when others =>
               Error_Kind ("rti.generate_fileacc_type_definition", Atype);
         end case;
         if Base_Type = Null_Iir then
            Info.T.Rti_Max_Depth := 0;
         else
            Info.T.Rti_Max_Depth := Get_Info (Base_Type).T.Rti_Max_Depth;
         end if;
         Name := Generate_Type_Name (Atype);

         Start_Const_Value (Info.Type_Rti);
         Start_Record_Aggr (List, Ghdl_Rtin_Type_Fileacc);
         New_Record_Aggr_El
           (List, Generate_Common_Type (Kind, 0, Info.T.Rti_Max_Depth));
         New_Record_Aggr_El (List, New_Name_Address (Name));
         New_Record_Aggr_El (List, New_Rti_Address (Base));
         Finish_Record_Aggr (List, Val);
         Finish_Const_Value (Info.Type_Rti, Val);
      end Generate_Fileacc_Type_Definition;

      procedure Generate_Array_Type_Indexes
        (Atype : Iir; Res : out O_Dnode; Max_Depth : in out Rti_Depth_Type)
      is
         List : constant Iir_List := Get_Index_Subtype_List (Atype);
         Nbr_Indexes : constant Natural := Get_Nbr_Elements (List);
         Index : Iir;
         Tmp : O_Dnode;
         pragma Unreferenced (Tmp);
         Arr_Type : O_Tnode;
         Arr_Aggr : O_Array_Aggr_List;
         Val : O_Cnode;
         Mark : Id_Mark_Type;
      begin
         --  Translate each index.
         for I in 1 .. Nbr_Indexes loop
            Index := Get_Index_Type (List, I - 1);
            Push_Identifier_Prefix (Mark, "DIM", Iir_Int32 (I));
            Tmp := Generate_Type_Definition (Index);
            Max_Depth := Rti_Depth_Type'Max (Max_Depth,
                                             Get_Info (Index).T.Rti_Max_Depth);
            Pop_Identifier_Prefix (Mark);
         end loop;

         --  Generate array of index.
         Arr_Type := New_Constrained_Array_Type
           (Ghdl_Rti_Array,
            New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Indexes)));
         New_Const_Decl (Res, Create_Identifier ("RTIINDEXES"),
                         Global_Storage, Arr_Type);
         Start_Const_Value (Res);

         Start_Array_Aggr (Arr_Aggr, Arr_Type);
         for I in 1 .. Nbr_Indexes loop
            Index := Get_Index_Type (List, I - 1);
            New_Array_Aggr_El
              (Arr_Aggr, New_Rti_Address (Generate_Type_Definition (Index)));
         end loop;
         Finish_Array_Aggr (Arr_Aggr, Val);
         Finish_Const_Value (Res, Val);
      end Generate_Array_Type_Indexes;

      function Type_To_Mode (Atype : Iir) return Natural is
         Res : Natural := 0;
      begin
         if Is_Complex_Type (Get_Info (Atype)) then
            Res := Res + 1;
         end if;
         if Is_Anonymous_Type_Definition (Atype)
           or else (Get_Kind (Get_Type_Declarator (Atype))
                      = Iir_Kind_Anonymous_Type_Declaration)
         then
            Res := Res + 2;
         end if;
         return Res;
      end Type_To_Mode;

      procedure Generate_Array_Type_Definition
        (Atype : Iir_Array_Type_Definition)
      is
         Info : Type_Info_Acc;
         Aggr : O_Record_Aggr_List;
         Val : O_Cnode;
         List : Iir_List;
         Arr : O_Dnode;
         Element : Iir;
         Name : O_Dnode;
         El_Info : Type_Info_Acc;
         Max_Depth : Rti_Depth_Type;
      begin
         Info := Get_Info (Atype);

         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Array);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Name := Generate_Type_Name (Atype);
         Element := Get_Element_Subtype (Atype);
         El_Info := Get_Info (Element);
         if El_Info.Type_Rti = O_Dnode_Null then
            declare
               Mark : Id_Mark_Type;
               El_Rti : O_Dnode;
               pragma Unreferenced (El_Rti);
            begin
               Push_Identifier_Prefix (Mark, "EL");
               El_Rti := Generate_Type_Definition (Element);
               Pop_Identifier_Prefix (Mark);
            end;
         end if;
         Max_Depth := El_Info.T.Rti_Max_Depth;

         --  Translate each index.
         Generate_Array_Type_Indexes (Atype, Arr, Max_Depth);
         Info.T.Rti_Max_Depth := Max_Depth;
         List := Get_Index_Subtype_List (Atype);

         --  Generate node.
         Start_Const_Value (Info.Type_Rti);
         Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Array);
         New_Record_Aggr_El
           (Aggr,
            Generate_Common_Type
            (Ghdl_Rtik_Type_Array, 0, Max_Depth, Type_To_Mode (Atype)));
         New_Record_Aggr_El (Aggr, New_Name_Address (Name));
         New_Record_Aggr_El (Aggr, New_Rti_Address (El_Info.Type_Rti));
         New_Record_Aggr_El
           (Aggr,
            New_Unsigned_Literal (Ghdl_Index_Type,
                                  Unsigned_64 (Get_Nbr_Elements (List))));
         New_Record_Aggr_El (Aggr, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
         Finish_Record_Aggr (Aggr, Val);
         Finish_Const_Value (Info.Type_Rti, Val);
      end Generate_Array_Type_Definition;

      procedure Generate_Array_Subtype_Definition
        (Atype : Iir_Array_Subtype_Definition)
      is
         Base_Type : Iir;
         Base_Info : Type_Info_Acc;
         Info : Type_Info_Acc;
         Aggr : O_Record_Aggr_List;
         Val : O_Cnode;
         Base_Rti : O_Dnode;
         pragma Unreferenced (Base_Rti);
         Bounds : Var_Acc;
         Name : O_Dnode;
         Kind : O_Cnode;
         Mark : Id_Mark_Type;
         Depth : Rti_Depth_Type;
      begin
         --  FIXME: temporary work-around
         if Get_Constraint_State (Atype) /= Fully_Constrained then
            return;
         end if;

         Info := Get_Info (Atype);

         Base_Type := Get_Base_Type (Atype);
         Base_Info := Get_Info (Base_Type);
         if Base_Info.Type_Rti = O_Dnode_Null then
            Push_Identifier_Prefix (Mark, "BT");
            Base_Rti := Generate_Type_Definition (Base_Type);
            Pop_Identifier_Prefix (Mark);
         end if;

         Bounds := Info.T.Array_Bounds;
         Depth := Get_Depth_From_Var (Bounds);
         Info.T.Rti_Max_Depth :=
           Rti_Depth_Type'Max (Depth, Base_Info.T.Rti_Max_Depth);

         --  Generate node.
         Generate_Type_Rti (Info, Ghdl_Rtin_Subtype_Array);

         if Global_Storage = O_Storage_External then
            return;
         end if;

         Name := Generate_Type_Name (Atype);

         Start_Const_Value (Info.Type_Rti);
         Start_Record_Aggr (Aggr, Ghdl_Rtin_Subtype_Array);
         case Info.Type_Mode is
            when Type_Mode_Array =>
               Kind := Ghdl_Rtik_Subtype_Array;
            when Type_Mode_Fat_Array =>
               Kind := Ghdl_Rtik_Subtype_Unconstrained_Array;
            when others =>
               Error_Kind ("generate_array_subtype_definition", Atype);
         end case;
         New_Record_Aggr_El
           (Aggr,
            Generate_Common_Type
              (Kind, Depth, Info.T.Rti_Max_Depth, Type_To_Mode (Atype)));
         New_Record_Aggr_El (Aggr, New_Name_Address (Name));
         New_Record_Aggr_El (Aggr, New_Rti_Address (Base_Info.Type_Rti));
         if Bounds = null then
            Val := Get_Null_Loc;
         else
            Val := Var_Acc_To_Loc (Bounds);
         end if;
         New_Record_Aggr_El (Aggr, Val);
         for I in Mode_Value .. Mode_Signal loop
            case Info.Type_Mode is
               when Type_Mode_Array =>
                  Val := Get_Null_Loc;
                  if Info.Ortho_Type (I) /= O_Tnode_Null then
                     if Is_Complex_Type (Info) then
                        if Info.C (I).Size_Var /= null then
                           Val := Var_Acc_To_Loc (Info.C (I).Size_Var);
                        end if;
                     else
                        Val := New_Sizeof (Info.Ortho_Type (I),
                                           Ghdl_Ptr_Type);
                     end if;
                  end if;
               when Type_Mode_Fat_Array =>
                  Val := Get_Null_Loc;
               when others =>
                  Error_Kind ("generate_array_subtype_definition", Atype);
            end case;
            New_Record_Aggr_El (Aggr, Val);
         end loop;

         Finish_Record_Aggr (Aggr, Val);
         Finish_Const_Value (Info.Type_Rti, Val);
      end Generate_Array_Subtype_Definition;

      procedure Generate_Record_Type_Definition (Atype : Iir)
      is
         El_List : Iir_List;
         El : Iir;
         Prev : Rti_Block;
         El_Arr : O_Dnode;
         Res : O_Cnode;
         Info : constant Type_Info_Acc := Get_Info (Atype);
         Max_Depth : Rti_Depth_Type;
      begin
         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Record);
         if Global_Storage = O_Storage_External then
            return;
         end if;

         El_List := Get_Elements_Declaration_List (Atype);
         Max_Depth := 0;

         --  Generate elements.
         Push_Rti_Node (Prev, False);
         for I in Natural loop
            El := Get_Nth_Element (El_List, I);
            exit when El = Null_Iir;
            declare
               Type_Rti : O_Dnode;
               El_Name : O_Dnode;
               El_Type : constant Iir := Get_Type (El);
               Aggr : O_Record_Aggr_List;
               Field_Info : constant Field_Info_Acc := Get_Info (El);
               Val : O_Cnode;
               El_Const : O_Dnode;
               Mark : Id_Mark_Type;
            begin
               Push_Identifier_Prefix (Mark, Get_Identifier (El));

               Type_Rti := Generate_Type_Definition (El_Type);
               Max_Depth :=
                 Rti_Depth_Type'Max (Max_Depth,
                                     Get_Info (El_Type).T.Rti_Max_Depth);

               El_Name := Generate_Name (El);
               New_Const_Decl (El_Const, Create_Identifier ("RTIEL"),
                               Global_Storage, Ghdl_Rtin_Element);
               Start_Const_Value (El_Const);
               Start_Record_Aggr (Aggr, Ghdl_Rtin_Element);
               New_Record_Aggr_El (Aggr,
                                   Generate_Common (Ghdl_Rtik_Element));
               New_Record_Aggr_El (Aggr, New_Name_Address (El_Name));
               New_Record_Aggr_El (Aggr, New_Rti_Address (Type_Rti));
               for I in Object_Kind_Type loop
                  if Field_Info.Field_Node (I) /= O_Fnode_Null then
                     Val := New_Offsetof (Info.Ortho_Type (I),
                                          Field_Info.Field_Node (I),
                                          Ghdl_Index_Type);
                  else
                     Val := Ghdl_Index_0;
                  end if;
                  New_Record_Aggr_El (Aggr, Val);
               end loop;
               Finish_Record_Aggr (Aggr, Val);
               Finish_Const_Value (El_Const, Val);
               Add_Rti_Node (El_Const);

               Pop_Identifier_Prefix (Mark);
            end;
         end loop;
         El_Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));
         Pop_Rti_Node (Prev);

         Info.T.Rti_Max_Depth := Max_Depth;
         --  Generate record.
         declare
            Aggr : O_Record_Aggr_List;
            Name : O_Dnode;
         begin
            Name := Generate_Type_Name (Atype);

            Start_Const_Value (Info.Type_Rti);
            Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Record);
            New_Record_Aggr_El
              (Aggr,
               Generate_Common_Type (Ghdl_Rtik_Type_Record, 0, Max_Depth,
                                     Type_To_Mode (Atype)));
            New_Record_Aggr_El (Aggr, New_Name_Address (Name));
            New_Record_Aggr_El
              (Aggr, New_Unsigned_Literal
               (Ghdl_Index_Type, Unsigned_64 (Get_Nbr_Elements (El_List))));
            New_Record_Aggr_El (Aggr,
                                New_Global_Address (El_Arr, Ghdl_Rti_Arr_Acc));
            Finish_Record_Aggr (Aggr, Res);
            Finish_Const_Value (Info.Type_Rti, Res);
         end;
      end Generate_Record_Type_Definition;

      procedure Generate_Protected_Type_Declaration (Atype : Iir)
      is
         Info : Type_Info_Acc;
         Name : O_Dnode;
         Val : O_Cnode;
         List : O_Record_Aggr_List;
      begin
         Info := Get_Info (Atype);
         Generate_Type_Rti (Info, Ghdl_Rtin_Type_Scalar);
         if Global_Storage = O_Storage_External then
            return;
         end if;

         Name := Generate_Type_Name (Atype);
         Start_Const_Value (Info.Type_Rti);
         Start_Record_Aggr (List, Ghdl_Rtin_Type_Scalar);
         New_Record_Aggr_El
           (List,
            Generate_Common_Type (Ghdl_Rtik_Type_Protected, 0, 0,
                                  Type_To_Mode (Atype)));
         New_Record_Aggr_El (List, New_Name_Address (Name));
         Finish_Record_Aggr (List, Val);
         Finish_Const_Value (Info.Type_Rti, Val);
      end Generate_Protected_Type_Declaration;

      --  If FORCE is true, force the creation of the type RTI.
      --  Otherwise, only the declaration (and not the definition) may have
      --  been created.
      function Generate_Type_Definition (Atype : Iir; Force : Boolean := False)
                                        return O_Dnode
      is
         Info : constant Type_Info_Acc := Get_Info (Atype);
      begin
         if not Force and then Info.Type_Rti /= O_Dnode_Null then
            return Info.Type_Rti;
         end if;
         case Get_Kind (Atype) is
            when Iir_Kind_Integer_Type_Definition
              | Iir_Kind_Floating_Type_Definition
              | Iir_Kind_Physical_Type_Definition =>
               raise Internal_Error;
            when Iir_Kind_Enumeration_Type_Definition =>
               Generate_Enumeration_Type_Definition (Atype);
            when Iir_Kind_Integer_Subtype_Definition
              | Iir_Kind_Floating_Subtype_Definition
              | Iir_Kind_Enumeration_Subtype_Definition
              | Iir_Kind_Physical_Subtype_Definition =>
               Generate_Scalar_Subtype_Definition (Atype);
            when Iir_Kind_Array_Type_Definition =>
               Generate_Array_Type_Definition (Atype);
            when Iir_Kind_Array_Subtype_Definition =>
               Generate_Array_Subtype_Definition (Atype);
            when Iir_Kind_Access_Type_Definition
              | Iir_Kind_File_Type_Definition =>
               Generate_Fileacc_Type_Definition (Atype);
            when Iir_Kind_Record_Subtype_Definition
              | Iir_Kind_Access_Subtype_Definition =>
               --  FIXME: No separate infos (yet).
               null;
            when Iir_Kind_Record_Type_Definition =>
               Generate_Record_Type_Definition (Atype);
            when Iir_Kind_Protected_Type_Declaration =>
               Generate_Protected_Type_Declaration (Atype);
            when others =>
               Error_Kind ("rti.generate_type_definition", Atype);
               return O_Dnode_Null;
         end case;
         return Info.Type_Rti;
      end Generate_Type_Definition;

      function Generate_Incomplete_Type_Definition (Def : Iir)
        return O_Dnode
      is
         Ndef : constant Iir := Get_Type (Get_Type_Declarator (Def));
         Info : constant Type_Info_Acc := Get_Info (Ndef);
         Rti_Type : O_Tnode;
      begin
         case Get_Kind (Ndef) is
            when Iir_Kind_Integer_Type_Definition
              | Iir_Kind_Floating_Type_Definition =>
               Rti_Type := Ghdl_Rtin_Type_Scalar;
            when Iir_Kind_Physical_Type_Definition =>
               Rti_Type := Ghdl_Rtin_Type_Physical;
            when Iir_Kind_Enumeration_Type_Definition =>
               Rti_Type := Ghdl_Rtin_Type_Enum;
            when Iir_Kind_Integer_Subtype_Definition
              | Iir_Kind_Floating_Subtype_Definition
              | Iir_Kind_Enumeration_Subtype_Definition
              | Iir_Kind_Physical_Subtype_Definition =>
               Rti_Type := Ghdl_Rtin_Subtype_Scalar;
            when Iir_Kind_Array_Type_Definition =>
               Rti_Type := Ghdl_Rtin_Type_Array;
            when Iir_Kind_Array_Subtype_Definition =>
               Rti_Type := Ghdl_Rtin_Subtype_Array;
            when Iir_Kind_Access_Type_Definition
              | Iir_Kind_File_Type_Definition =>
               Rti_Type := Ghdl_Rtin_Type_Fileacc;
            when Iir_Kind_Record_Type_Definition =>
               Rti_Type := Ghdl_Rtin_Type_Record;
            when others =>
               Error_Kind ("rti.generate_incomplete_type_definition", Ndef);
         end case;
         New_Const_Decl (Info.Type_Rti, Create_Identifier ("RTI"),
                         Global_Storage, Rti_Type);
         return Info.Type_Rti;
      end Generate_Incomplete_Type_Definition;

      function Generate_Type_Decl (Decl : Iir) return O_Dnode
      is
         Id : constant Name_Id := Get_Identifier (Decl);
         Def : constant Iir := Get_Type (Decl);
         Rti : O_Dnode;
         Mark : Id_Mark_Type;
      begin
         Push_Identifier_Prefix (Mark, Id);
         if Get_Kind (Def) = Iir_Kind_Incomplete_Type_Definition then
            Rti := Generate_Incomplete_Type_Definition (Def);
         else
            Rti := Generate_Type_Definition (Def, True);
         end if;
         Pop_Identifier_Prefix (Mark);
         return Rti;
      end Generate_Type_Decl;

      procedure Generate_Signal_Rti (Sig : Iir)
      is
         Info : Object_Info_Acc;
      begin
         Info := Get_Info (Sig);
         New_Const_Decl (Info.Object_Rti, Create_Identifier (Sig, "__RTI"),
                         Global_Storage, Ghdl_Rtin_Object);
      end Generate_Signal_Rti;

      procedure Generate_Object (Decl : Iir; Rti : in out O_Dnode)
      is
         Decl_Type : Iir;
         Type_Info : Type_Info_Acc;
         Name : O_Dnode;
         Comm : O_Cnode;
         Val : O_Cnode;
         List : O_Record_Aggr_List;
         Info : Ortho_Info_Acc;
         Mark : Id_Mark_Type;
         Var : Var_Acc;
         Mode : Natural;
         Has_Id : Boolean;
      begin
         case Get_Kind (Decl) is
            when Iir_Kind_Transaction_Attribute
              | Iir_Kind_Stable_Attribute
              | Iir_Kind_Quiet_Attribute
              | Iir_Kind_Delayed_Attribute =>
               Has_Id := False;
               Push_Identifier_Prefix_Uniq (Mark);
            when others =>
               Has_Id := True;
               Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
         end case;

         if Rti = O_Dnode_Null then
            New_Const_Decl (Rti, Create_Identifier ("RTI"),
                            Global_Storage, Ghdl_Rtin_Object);
         end if;

         if Global_Storage /= O_Storage_External then
            Decl_Type := Get_Type (Decl);
            Type_Info := Get_Info (Decl_Type);
            if Type_Info.Type_Rti = O_Dnode_Null then
               declare
                  Mark : Id_Mark_Type;
                  Tmp : O_Dnode;
                  pragma Unreferenced (Tmp);
               begin
                  Push_Identifier_Prefix (Mark, "OT");
                  Tmp := Generate_Type_Definition (Decl_Type);
                  Pop_Identifier_Prefix (Mark);
               end;
            end if;

            if Has_Id then
               Name := Generate_Name (Decl);
            else
               Name := O_Dnode_Null;
            end if;

            Info := Get_Info (Decl);

            Start_Const_Value (Rti);
            Start_Record_Aggr (List, Ghdl_Rtin_Object);
            Mode := 0;
            case Get_Kind (Decl) is
               when Iir_Kind_Signal_Declaration =>
                  Comm := Ghdl_Rtik_Signal;
                  Var := Info.Object_Var;
               when Iir_Kind_Signal_Interface_Declaration =>
                  Comm := Ghdl_Rtik_Port;
                  Var := Info.Object_Var;
                  Mode := Iir_Mode'Pos (Get_Mode (Decl));
               when Iir_Kind_Constant_Declaration =>
                  Comm := Ghdl_Rtik_Constant;
                  Var := Info.Object_Var;
               when Iir_Kind_Constant_Interface_Declaration =>
                  Comm := Ghdl_Rtik_Generic;
                  Var := Info.Object_Var;
               when Iir_Kind_Variable_Declaration =>
                  Comm := Ghdl_Rtik_Variable;
                  Var := Info.Object_Var;
               when Iir_Kind_Guard_Signal_Declaration =>
                  Comm := Ghdl_Rtik_Guard;
                  Var := Info.Object_Var;
               when Iir_Kind_Iterator_Declaration =>
                  Comm := Ghdl_Rtik_Iterator;
                  Var := Info.Iterator_Var;
               when Iir_Kind_File_Declaration =>
                  Comm := Ghdl_Rtik_File;
                  Var := Info.Object_Var;
               when Iir_Kind_Attribute_Declaration =>
                  Comm := Ghdl_Rtik_Attribute;
                  Var := null;
               when Iir_Kind_Transaction_Attribute =>
                  Comm := Ghdl_Rtik_Attribute_Transaction;
                  Var := Info.Object_Var;
               when Iir_Kind_Quiet_Attribute =>
                  Comm := Ghdl_Rtik_Attribute_Quiet;
                  Var := Info.Object_Var;
               when Iir_Kind_Stable_Attribute =>
                  Comm := Ghdl_Rtik_Attribute_Stable;
                  Var := Info.Object_Var;
               when Iir_Kind_Object_Alias_Declaration =>
                  Comm := Ghdl_Rtik_Alias;
                  Var := Info.Alias_Var;
                  Mode := Object_Kind_Type'Pos (Info.Alias_Kind);
               when others =>
                  Error_Kind ("rti.generate_object", Decl);
            end case;
            case Get_Kind (Decl) is
               when Iir_Kind_Signal_Declaration
                 | Iir_Kind_Signal_Interface_Declaration =>
                  Mode := Mode
                    + 16 * Iir_Signal_Kind'Pos (Get_Signal_Kind (Decl));
               when others =>
                  null;
            end case;
            case Get_Kind (Decl) is
               when Iir_Kind_Signal_Declaration
                 | Iir_Kind_Signal_Interface_Declaration
                 | Iir_Kind_Guard_Signal_Declaration
                 | Iir_Kind_Transaction_Attribute
                 | Iir_Kind_Stable_Attribute
                 | Iir_Kind_Quiet_Attribute
                 | Iir_Kind_Delayed_Attribute =>
                  if Get_Has_Active_Flag (Decl) then
                     Mode := Mode + 64;
                  end if;
               when others =>
                  null;
            end case;
            New_Record_Aggr_El (List, Generate_Common (Comm, Var, Mode));
            New_Record_Aggr_El (List, New_Name_Address (Name));
            if Var = null then
               Val := Get_Null_Loc;
            else
               Val := Var_Acc_To_Loc (Var);
            end if;
            New_Record_Aggr_El (List, Val);
            New_Record_Aggr_El (List, New_Rti_Address (Type_Info.Type_Rti));
            Finish_Record_Aggr (List, Val);
            Finish_Const_Value (Rti, Val);
         end if;
         Pop_Identifier_Prefix (Mark);
      end Generate_Object;

      procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode);
      procedure Generate_Declaration_Chain (Chain : Iir);

      procedure Generate_Component_Declaration (Comp : Iir)
      is
         Prev : Rti_Block;
         Name : O_Dnode;
         Arr : O_Dnode;
         List : O_Record_Aggr_List;
         Res : O_Cnode;
         Mark : Id_Mark_Type;
         Info : Comp_Info_Acc;
      begin
         Push_Identifier_Prefix (Mark, Get_Identifier (Comp));
         Info := Get_Info (Comp);

         New_Const_Decl (Info.Comp_Rti_Const, Create_Identifier ("RTI"),
                         Global_Storage, Ghdl_Rtin_Component);

         if Global_Storage /= O_Storage_External then
            Push_Rti_Node (Prev);

            Generate_Declaration_Chain (Get_Generic_Chain (Comp));
            Generate_Declaration_Chain (Get_Port_Chain (Comp));

            Name := Generate_Name (Comp);

            Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));

            Start_Const_Value (Info.Comp_Rti_Const);
            Start_Record_Aggr (List, Ghdl_Rtin_Component);
            New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Component));
            New_Record_Aggr_El (List,
                                New_Global_Address (Name, Char_Ptr_Type));
            New_Record_Aggr_El
              (List, New_Unsigned_Literal (Ghdl_Index_Type,
                                           Unsigned_64 (Cur_Block.Nbr)));
            New_Record_Aggr_El (List,
                                New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
            Finish_Record_Aggr (List, Res);
            Finish_Const_Value (Info.Comp_Rti_Const, Res);
            Pop_Rti_Node (Prev);
         end if;

         Pop_Identifier_Prefix (Mark);
         Add_Rti_Node (Info.Comp_Rti_Const);
      end Generate_Component_Declaration;

      --  Generate RTIs only for types.
      procedure Generate_Declaration_Chain_Depleted (Chain : Iir)
      is
         Decl : Iir;
      begin
         Decl := Chain;
         while Decl /= Null_Iir loop
            case Get_Kind (Decl) is
               when Iir_Kind_Use_Clause =>
                  null;
               when Iir_Kind_Type_Declaration =>
                  --  FIXME: physicals ?
                  if Get_Kind (Get_Type_Definition (Decl))
                    = Iir_Kind_Enumeration_Type_Definition
                  then
                     Add_Rti_Node (Generate_Type_Decl (Decl));
                  end if;
               when Iir_Kind_Subtype_Declaration =>
                  --  In a subprogram, a subtype may depends on parameters.
                  --  Eg: array subtypes.
                  null;
               when Iir_Kind_Signal_Declaration
                 | Iir_Kind_Signal_Interface_Declaration
                 | Iir_Kind_Constant_Declaration
                 | Iir_Kind_Constant_Interface_Declaration
                 | Iir_Kind_Variable_Declaration
                 | Iir_Kind_File_Declaration
                 | Iir_Kind_Transaction_Attribute
                 | Iir_Kind_Quiet_Attribute
                 | Iir_Kind_Stable_Attribute =>
                  null;
               when Iir_Kind_Delayed_Attribute =>
                  --  FIXME: to be added.
                  null;
               when Iir_Kind_Object_Alias_Declaration
                 | Iir_Kind_Attribute_Declaration =>
                  null;
               when Iir_Kind_Component_Declaration =>
                  null;
               when Iir_Kind_Implicit_Function_Declaration
                 | Iir_Kind_Implicit_Procedure_Declaration
                 | Iir_Kind_Function_Declaration
                 | Iir_Kind_Procedure_Declaration =>
                  --  FIXME: to be added (for foreign).
                  null;
               when Iir_Kind_Function_Body
                 | Iir_Kind_Procedure_Body =>
                  null;
               when Iir_Kind_Anonymous_Type_Declaration =>
                  --  Handled in subtype declaration.
                  null;
               when Iir_Kind_Configuration_Specification
                 | Iir_Kind_Attribute_Specification
                 | Iir_Kind_Disconnection_Specification =>
                  null;
               when Iir_Kind_Protected_Type_Body =>
                  null;
               when Iir_Kind_Non_Object_Alias_Declaration =>
                  null;
               when Iir_Kind_Group_Template_Declaration
                 | Iir_Kind_Group_Declaration =>
                  null;
               when others =>
                  Error_Kind ("rti.generate_declaration_chain_depleted", Decl);
            end case;
            Decl := Get_Chain (Decl);
         end loop;
      end Generate_Declaration_Chain_Depleted;

      procedure Generate_Subprogram_Body (Bod : Iir)
      is
         --Decl : Iir;
         --Mark : Id_Mark_Type;
      begin
         --Decl := Get_Subprogram_Specification (Bod);

         --Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
         --  Generate RTI only for types.
         Generate_Declaration_Chain_Depleted (Get_Declaration_Chain (Bod));
         --Pop_Identifier_Prefix (Mark);
      end Generate_Subprogram_Body;

      procedure Generate_Instance (Stmt : Iir; Parent : O_Dnode)
      is
         Name : O_Dnode;
         List : O_Record_Aggr_List;
         Val : O_Cnode;
         Inst : constant Iir := Get_Instantiated_Unit (Stmt);
         Info : constant Block_Info_Acc := Get_Info (Stmt);
      begin
         Name := Generate_Name (Stmt);

         New_Const_Decl (Info.Block_Rti_Const, Create_Identifier ("RTI"),
                         Global_Storage, Ghdl_Rtin_Instance);

         Start_Const_Value (Info.Block_Rti_Const);
         Start_Record_Aggr (List, Ghdl_Rtin_Instance);
         New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Instance));
         New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
         New_Record_Aggr_El
           (List, New_Offsetof (Get_Info (Get_Parent (Stmt)).Block_Decls_Type,
                                Info.Block_Link_Field,
                                Ghdl_Ptr_Type));
         New_Record_Aggr_El (List, New_Rti_Address (Parent));
         case Get_Kind (Inst) is
            when Iir_Kinds_Denoting_Name =>
               Val := New_Rti_Address
                 (Get_Info (Get_Named_Entity (Inst)).Comp_Rti_Const);
            when Iir_Kind_Entity_Aspect_Entity =>
               declare
                  Ent : constant Iir := Get_Entity (Inst);
               begin
                  Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const);
               end;
            when Iir_Kind_Entity_Aspect_Configuration =>
               declare
                  Config : constant Iir := Get_Configuration (Inst);
                  Ent : constant Iir := Get_Entity (Config);
               begin
                  Val := New_Rti_Address (Get_Info (Ent).Block_Rti_Const);
               end;
            when others =>
               Val := New_Null_Access (Ghdl_Rti_Access);
         end case;

         New_Record_Aggr_El (List, Val);
         Finish_Record_Aggr (List, Val);
         Finish_Const_Value (Info.Block_Rti_Const, Val);
         Add_Rti_Node (Info.Block_Rti_Const);
      end Generate_Instance;

      procedure Generate_Psl_Directive (Stmt : Iir)
      is
         Name : O_Dnode;
         List : O_Record_Aggr_List;

         Rti : O_Dnode;
         Res : O_Cnode;
         Info : constant Psl_Info_Acc := Get_Info (Stmt);
         Mark : Id_Mark_Type;
      begin
         Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
         Name := Generate_Name (Stmt);

         New_Const_Decl (Rti, Create_Identifier ("RTI"),
                         O_Storage_Public, Ghdl_Rtin_Type_Scalar);

         Start_Const_Value (Rti);
         Start_Record_Aggr (List, Ghdl_Rtin_Type_Scalar);
         New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_Psl_Assert));
         New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
         Finish_Record_Aggr (List, Res);
         Finish_Const_Value (Rti, Res);
         Info.Psl_Rti_Const := Rti;
         Pop_Identifier_Prefix (Mark);
      end Generate_Psl_Directive;

      procedure Generate_Declaration_Chain (Chain : Iir)
      is
         Decl : Iir;
      begin
         Decl := Chain;
         while Decl /= Null_Iir loop
            case Get_Kind (Decl) is
               when Iir_Kind_Use_Clause =>
                  null;
               when Iir_Kind_Anonymous_Type_Declaration =>
                  --  Handled in subtype declaration.
                  null;
               when Iir_Kind_Type_Declaration
                 | Iir_Kind_Subtype_Declaration =>
                  Add_Rti_Node (Generate_Type_Decl (Decl));
               when Iir_Kind_Constant_Declaration =>
                  --  Do not generate RTIs for full declarations.
                  --  (RTI will be generated for the deferred declaration).
                  if Get_Deferred_Declaration (Decl) = Null_Iir
                    or else Get_Deferred_Declaration_Flag (Decl)
                  then
                     declare
                        Info : Object_Info_Acc;
                     begin
                        Info := Get_Info (Decl);
                        Generate_Object (Decl, Info.Object_Rti);
                        Add_Rti_Node (Info.Object_Rti);
                     end;
                  end if;
               when Iir_Kind_Signal_Declaration
                 | Iir_Kind_Signal_Interface_Declaration
                 | Iir_Kind_Constant_Interface_Declaration
                 | Iir_Kind_Variable_Declaration
                 | Iir_Kind_File_Declaration
                 | Iir_Kind_Transaction_Attribute
                 | Iir_Kind_Quiet_Attribute
                 | Iir_Kind_Stable_Attribute =>
                  declare
                     Info : Object_Info_Acc;
                  begin
                     Info := Get_Info (Decl);
                     Generate_Object (Decl, Info.Object_Rti);
                     Add_Rti_Node (Info.Object_Rti);
                  end;
               when Iir_Kind_Delayed_Attribute =>
                  --  FIXME: to be added.
                  null;
               when Iir_Kind_Object_Alias_Declaration
                 | Iir_Kind_Attribute_Declaration =>
                  declare
                     Rti : O_Dnode := O_Dnode_Null;
                  begin
                     Generate_Object (Decl, Rti);
                     Add_Rti_Node (Rti);
                  end;
               when Iir_Kind_Component_Declaration =>
                  Generate_Component_Declaration (Decl);
               when Iir_Kind_Implicit_Function_Declaration
                 | Iir_Kind_Implicit_Procedure_Declaration
                 | Iir_Kind_Function_Declaration
                 | Iir_Kind_Procedure_Declaration =>
                  --  FIXME: to be added (for foreign).
                  null;
               when Iir_Kind_Function_Body
                 | Iir_Kind_Procedure_Body =>
                  --  Already handled by Translate_Subprogram_Body.
                  null;
               when Iir_Kind_Configuration_Specification
                 | Iir_Kind_Attribute_Specification
                 | Iir_Kind_Disconnection_Specification =>
                  null;
               when Iir_Kind_Protected_Type_Body =>
                  null;
               when Iir_Kind_Non_Object_Alias_Declaration =>
                  null;
               when Iir_Kind_Group_Template_Declaration
                 | Iir_Kind_Group_Declaration =>
                  null;
               when others =>
                  Error_Kind ("rti.generate_declaration_chain", Decl);
            end case;
            Decl := Get_Chain (Decl);
         end loop;
      end Generate_Declaration_Chain;

      procedure Generate_Concurrent_Statement_Chain
        (Chain : Iir; Parent_Rti : O_Dnode)
      is
         Stmt : Iir;
         Mark : Id_Mark_Type;
      begin
         Stmt := Chain;
         while Stmt /= Null_Iir loop
            case Get_Kind (Stmt) is
               when Iir_Kind_Process_Statement
                 | Iir_Kind_Sensitized_Process_Statement
                 | Iir_Kind_Block_Statement
                 | Iir_Kind_Generate_Statement =>
                  Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
                  Generate_Block (Stmt, Parent_Rti);
                  Pop_Identifier_Prefix (Mark);
               when Iir_Kind_Component_Instantiation_Statement =>
                  Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
                  Generate_Instance (Stmt, Parent_Rti);
                  Pop_Identifier_Prefix (Mark);
               when Iir_Kind_Psl_Default_Clock =>
                  null;
               when Iir_Kind_Psl_Declaration =>
                  null;
               when Iir_Kind_Psl_Assert_Statement =>
                  Generate_Psl_Directive (Stmt);
               when Iir_Kind_Psl_Cover_Statement =>
                  Generate_Psl_Directive (Stmt);
               when others =>
                  Error_Kind ("rti.generate_concurrent_statement_chain", Stmt);
            end case;
            Stmt := Get_Chain (Stmt);
         end loop;
      end Generate_Concurrent_Statement_Chain;

      procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode)
      is
         Name : O_Dnode;
         Arr : O_Dnode;
         List : O_Record_Aggr_List;

         Rti : O_Dnode;

         Kind : O_Cnode;
         Res : O_Cnode;

         Prev : Rti_Block;
         Info : Ortho_Info_Acc;

         Field : O_Fnode;
         Field_Parent : O_Tnode;
         Inst : O_Tnode;
      begin
         --  The type of a generator iterator is elaborated in the parent.
         if Get_Kind (Blk) = Iir_Kind_Generate_Statement then
            declare
               Scheme : Iir;
               Iter_Type : Iir;
               Type_Info : Type_Info_Acc;
               Mark : Id_Mark_Type;
               Tmp : O_Dnode;
            begin
               Scheme := Get_Generation_Scheme (Blk);
               if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
                  Iter_Type := Get_Type (Scheme);
                  Type_Info := Get_Info (Iter_Type);
                  if Type_Info.Type_Rti = O_Dnode_Null then
                     Push_Identifier_Prefix (Mark, "ITERATOR");
                     Tmp := Generate_Type_Definition (Iter_Type);
                     Add_Rti_Node (Tmp);
                     Pop_Identifier_Prefix (Mark);
                  end if;
               end if;
            end;
         end if;

         New_Const_Decl (Rti, Create_Identifier ("RTI"),
                         O_Storage_Public, Ghdl_Rtin_Block);
         Push_Rti_Node (Prev);

         Field := O_Fnode_Null;
         Inst := O_Tnode_Null;
         Info := Get_Info (Blk);
         case Get_Kind (Blk) is
            when Iir_Kind_Package_Declaration =>
               Kind := Ghdl_Rtik_Package;
               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
            when Iir_Kind_Package_Body =>
               Kind := Ghdl_Rtik_Package_Body;
               --  Required at least for 'image
               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
            when Iir_Kind_Architecture_Body =>
               Kind := Ghdl_Rtik_Architecture;
               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
               Generate_Concurrent_Statement_Chain
                 (Get_Concurrent_Statement_Chain (Blk), Rti);
               Field := Info.Block_Parent_Field;
               Inst := Info.Block_Decls_Type;
               Field_Parent := Info.Block_Decls_Type;
            when Iir_Kind_Entity_Declaration =>
               Kind := Ghdl_Rtik_Entity;
               Generate_Declaration_Chain (Get_Generic_Chain (Blk));
               Generate_Declaration_Chain (Get_Port_Chain (Blk));
               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
               Generate_Concurrent_Statement_Chain
                 (Get_Concurrent_Statement_Chain (Blk), Rti);
               Inst := Info.Block_Decls_Type;
            when Iir_Kind_Process_Statement
              | Iir_Kind_Sensitized_Process_Statement =>
               Kind := Ghdl_Rtik_Process;
               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
               Field := Info.Process_Parent_Field;
               Field_Parent := Get_Info (Get_Parent (Blk)).Block_Decls_Type;
               Inst := Info.Process_Decls_Type;
            when Iir_Kind_Block_Statement =>
               Kind := Ghdl_Rtik_Block;
               declare
                  Guard : Iir;
                  Header : Iir;
                  Guard_Info : Object_Info_Acc;
               begin
                  Guard := Get_Guard_Decl (Blk);
                  if Guard /= Null_Iir then
                     Guard_Info := Get_Info (Guard);
                     Generate_Object (Guard, Guard_Info.Object_Rti);
                     Add_Rti_Node (Guard_Info.Object_Rti);
                  end if;
                  Header := Get_Block_Header (Blk);
                  if Header /= Null_Iir then
                     Generate_Declaration_Chain (Get_Generic_Chain (Header));
                     Generate_Declaration_Chain (Get_Port_Chain (Header));
                  end if;
               end;
               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
               Generate_Concurrent_Statement_Chain
                 (Get_Concurrent_Statement_Chain (Blk), Rti);
               Field := Info.Block_Parent_Field;
               Field_Parent := Get_Info (Get_Parent (Blk)).Block_Decls_Type;
               Inst := Info.Block_Decls_Type;
            when Iir_Kind_Generate_Statement =>
               declare
                  Scheme : Iir;
                  Scheme_Rti : O_Dnode := O_Dnode_Null;
               begin
                  Scheme := Get_Generation_Scheme (Blk);
                  if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then
                     Generate_Object (Scheme, Scheme_Rti);
                     Add_Rti_Node (Scheme_Rti);
                     Kind := Ghdl_Rtik_For_Generate;
                  else
                     Kind := Ghdl_Rtik_If_Generate;
                  end if;
               end;
               Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
               Generate_Concurrent_Statement_Chain
                 (Get_Concurrent_Statement_Chain (Blk), Rti);
               Field := Info.Block_Parent_Field;
               Field_Parent := Get_Info (Get_Parent (Blk)).Block_Decls_Type;
               Inst := Info.Block_Decls_Type;
            when others =>
               Error_Kind ("rti.generate_block", Blk);
         end case;

         Name := Generate_Name (Blk);

         Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY"));

         Start_Const_Value (Rti);
         Start_Record_Aggr (List, Ghdl_Rtin_Block);
         New_Record_Aggr_El (List, Generate_Common (Kind));
         New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
         if Field = O_Fnode_Null then
            Res := Get_Null_Loc;
         else
            Res := New_Offsetof (Field_Parent, Field, Ghdl_Ptr_Type);
         end if;
         New_Record_Aggr_El (List, Res);
         if Parent_Rti = O_Dnode_Null then
            Res := New_Null_Access (Ghdl_Rti_Access);
         else
            Res := New_Rti_Address (Parent_Rti);
         end if;
         New_Record_Aggr_El (List, Res);
         if Inst = O_Tnode_Null then
            Res := Ghdl_Index_0;
         else
            Res := New_Sizeof (Inst, Ghdl_Index_Type);
         end if;
         New_Record_Aggr_El (List, Res);
         New_Record_Aggr_El
           (List, New_Unsigned_Literal (Ghdl_Index_Type,
                                        Unsigned_64 (Cur_Block.Nbr)));
         New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
         Finish_Record_Aggr (List, Res);
         Finish_Const_Value (Rti, Res);

         Pop_Rti_Node (Prev);

         --  Put children in the parent list.
         case Get_Kind (Blk) is
            when Iir_Kind_Block_Statement
              | Iir_Kind_Generate_Statement
              | Iir_Kind_Process_Statement
              | Iir_Kind_Sensitized_Process_Statement =>
               Add_Rti_Node (Rti);
            when others =>
               null;
         end case;

         --  Store the RTI.
         case Get_Kind (Blk) is
            when Iir_Kind_Entity_Declaration
              | Iir_Kind_Architecture_Body
              | Iir_Kind_Block_Statement
              | Iir_Kind_Generate_Statement =>
               Info.Block_Rti_Const := Rti;
            when Iir_Kind_Process_Statement
              | Iir_Kind_Sensitized_Process_Statement =>
               Info.Process_Rti_Const := Rti;
            when Iir_Kind_Package_Declaration =>
               Info.Package_Rti_Const := Rti;
            when Iir_Kind_Package_Body =>
               --  Replace package declaration RTI with the body one.
               Get_Info (Get_Package (Blk)).Package_Rti_Const := Rti;
            when others =>
               Error_Kind ("rti.generate_block", Blk);
         end case;
      end Generate_Block;

      procedure Generate_Library (Lib : Iir_Library_Declaration;
                                  Public : Boolean)
      is
         use Name_Table;
         Info : Library_Info_Acc;
         Id : Name_Id;
         Val : O_Cnode;
         Aggr : O_Record_Aggr_List;
         Name : O_Dnode;
         Storage : O_Storage;
      begin
         Info := Get_Info (Lib);
         if Info /= null then
            return;
         end if;
         Info := Add_Info (Lib, Kind_Library);

         if Lib = Libraries.Work_Library then
            Id := Libraries.Work_Library_Name;
         else
            Id := Get_Identifier (Lib);
         end if;

         if Public then
            Storage := O_Storage_Public;
         else
            Storage := O_Storage_External;
         end if;

         New_Const_Decl (Info.Library_Rti_Const,
                         Create_Identifier_Without_Prefix (Id, "__RTI"),
                         Storage, Ghdl_Rtin_Type_Scalar);

         if Public then
            Image (Id);
            Name := Create_String
              (Name_Buffer (1 .. Name_Length),
               Create_Identifier_Without_Prefix (Id, "__RTISTR"));
            Start_Const_Value (Info.Library_Rti_Const);
            Start_Record_Aggr (Aggr, Ghdl_Rtin_Type_Scalar);
            New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Library));
            New_Record_Aggr_El (Aggr, New_Name_Address (Name));
            Finish_Record_Aggr (Aggr, Val);
            Finish_Const_Value (Info.Library_Rti_Const, Val);
         end if;
      end Generate_Library;

      procedure Generate_Unit (Lib_Unit : Iir)
      is
         Rti : O_Dnode;
         Info : Ortho_Info_Acc;
         Mark : Id_Mark_Type;
      begin
         Info := Get_Info (Lib_Unit);
         case Get_Kind (Lib_Unit) is
            when Iir_Kind_Configuration_Declaration =>
               return;
            when Iir_Kind_Architecture_Body =>
               if Info.Block_Rti_Const /= O_Dnode_Null then
                  return;
               end if;
            when Iir_Kind_Package_Body =>
               Push_Identifier_Prefix (Mark, "BODY");
            when others =>
               null;
         end case;

         --  Declare node.
         if Global_Storage = O_Storage_External then
            New_Const_Decl (Rti, Create_Identifier ("RTI"),
                            O_Storage_External, Ghdl_Rtin_Block);
            case Get_Kind (Lib_Unit) is
               when Iir_Kind_Entity_Declaration
                 | Iir_Kind_Package_Declaration =>
                  declare
                     Prev : Rti_Block;
                  begin
                     Push_Rti_Node (Prev);
                     Generate_Declaration_Chain
                       (Get_Declaration_Chain (Lib_Unit));
                     Pop_Rti_Node (Prev);
                  end;
               when others =>
                  null;
            end case;
            case Get_Kind (Lib_Unit) is
               when Iir_Kind_Entity_Declaration
                 | Iir_Kind_Architecture_Body =>
                  Info.Block_Rti_Const := Rti;
               when Iir_Kind_Package_Declaration =>
                  Info.Package_Rti_Const := Rti;
               when Iir_Kind_Package_Body =>
                  --  Replace package declaration RTI with the body one.
                  Get_Info (Get_Package (Lib_Unit)).Package_Rti_Const := Rti;
               when others =>
                  null;
            end case;
         else
            case Get_Kind (Lib_Unit) is
               when Iir_Kind_Package_Declaration
                 | Iir_Kind_Entity_Declaration
                 | Iir_Kind_Configuration_Declaration =>
                  declare
                     Lib : Iir_Library_Declaration;
                  begin
                     Lib := Get_Library (Get_Design_File
                                         (Get_Design_Unit (Lib_Unit)));
                     Generate_Library (Lib, False);
                     Rti := Get_Info (Lib).Library_Rti_Const;
                  end;
               when Iir_Kind_Package_Body =>
                  Rti := Get_Info (Get_Package (Lib_Unit)).Package_Rti_Const;
               when Iir_Kind_Architecture_Body =>
                  Rti := Get_Info (Get_Entity (Lib_Unit)).Block_Rti_Const;
               when others =>
                  raise Internal_Error;
            end case;
            Generate_Block (Lib_Unit, Rti);
         end if;

         if Get_Kind (Lib_Unit) = Iir_Kind_Package_Body then
            Pop_Identifier_Prefix (Mark);
         end if;
      end Generate_Unit;

      procedure Generate_Top (Nbr_Pkgs : out Natural)
      is
         use Configuration;

         Unit : Iir_Design_Unit;
         Lib : Iir_Library_Declaration;
         Prev : Rti_Block;
      begin
         Push_Rti_Node (Prev);

         --  Generate RTI for libraries, count number of packages.
         Nbr_Pkgs := 1; --  At least std.standard.
         for I in Design_Units.First .. Design_Units.Last loop
            Unit := Design_Units.Table (I);

            --  Generate RTI for the library.
            Lib := Get_Library (Get_Design_File (Unit));
            Generate_Library (Lib, True);

            if Get_Kind (Get_Library_Unit (Unit))
              = Iir_Kind_Package_Declaration
            then
               Nbr_Pkgs := Nbr_Pkgs + 1;
            end if;
         end loop;

         Pop_Rti_Node (Prev);
      end Generate_Top;

      function Get_Context_Rti (Node : Iir) return O_Cnode
      is
         Node_Info : Ortho_Info_Acc;

         Rti_Const : O_Dnode;
      begin
         Node_Info := Get_Info (Node);

         case Get_Kind (Node) is
            when Iir_Kind_Component_Declaration =>
               Rti_Const := Node_Info.Comp_Rti_Const;
            when Iir_Kind_Component_Instantiation_Statement =>
               Rti_Const := Node_Info.Block_Rti_Const;
            when Iir_Kind_Entity_Declaration
              | Iir_Kind_Architecture_Body
              | Iir_Kind_Block_Statement
              | Iir_Kind_Generate_Statement =>
               Rti_Const := Node_Info.Block_Rti_Const;
            when Iir_Kind_Package_Declaration
              | Iir_Kind_Package_Body =>
               Rti_Const := Node_Info.Package_Rti_Const;
            when Iir_Kind_Process_Statement
              | Iir_Kind_Sensitized_Process_Statement =>
               Rti_Const := Node_Info.Process_Rti_Const;
            when Iir_Kind_Psl_Assert_Statement
              | Iir_Kind_Psl_Cover_Statement =>
               Rti_Const := Node_Info.Psl_Rti_Const;
            when others =>
               Error_Kind ("get_context_rti", Node);
         end case;
         return New_Rti_Address (Rti_Const);
      end Get_Context_Rti;

      function Get_Context_Addr (Node : Iir) return O_Enode
      is
         Node_Info : Ortho_Info_Acc;

         Block_Type : O_Tnode;
      begin
         Node_Info := Get_Info (Node);

         case Get_Kind (Node) is
            when Iir_Kind_Component_Declaration =>
               Block_Type := Node_Info.Comp_Type;
            when Iir_Kind_Entity_Declaration
              | Iir_Kind_Architecture_Body
              | Iir_Kind_Block_Statement
              | Iir_Kind_Generate_Statement =>
               Block_Type := Node_Info.Block_Decls_Type;
            when Iir_Kind_Package_Declaration
              | Iir_Kind_Package_Body =>
               return New_Lit (New_Null_Access (Ghdl_Ptr_Type));
            when Iir_Kind_Process_Statement
              | Iir_Kind_Sensitized_Process_Statement =>
               Block_Type := Node_Info.Process_Decls_Type;
            when Iir_Kind_Psl_Assert_Statement
              | Iir_Kind_Psl_Cover_Statement =>
               Block_Type := Node_Info.Psl_Decls_Type;
            when others =>
               Error_Kind ("get_context_addr", Node);
         end case;
         return New_Unchecked_Address (Get_Instance_Ref (Block_Type),
                                       Ghdl_Ptr_Type);
      end Get_Context_Addr;

      procedure Associate_Rti_Context (Assoc : in out O_Assoc_List; Node : Iir)
      is
      begin
         New_Association (Assoc, New_Lit (Get_Context_Rti (Node)));
         New_Association (Assoc, Get_Context_Addr (Node));
      end Associate_Rti_Context;

      procedure Associate_Null_Rti_Context (Assoc : in out O_Assoc_List) is
      begin
         New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Rti_Access)));
         New_Association (Assoc, New_Lit (New_Null_Access (Ghdl_Ptr_Type)));
      end Associate_Null_Rti_Context;
   end Rtis;

   procedure Gen_Filename (Design_File : Iir)
   is
      Info : Design_File_Info_Acc;
   begin
      if Current_Filename_Node /= O_Dnode_Null then
         raise Internal_Error;
      end if;
      Info := Get_Info (Design_File);
      if Info = null then
         Info := Add_Info (Design_File, Kind_Design_File);
         Info.Design_Filename := Create_String
           (Get_Design_File_Filename (Design_File),
            Create_Uniq_Identifier, O_Storage_Private);
      end if;
      Current_Filename_Node := Info.Design_Filename;
   end Gen_Filename;

   --  Decorate the tree in order to be usable with the internal simulator.
   procedure Translate (Unit : Iir_Design_Unit; Main : Boolean)
   is
      Design_File : Iir_Design_File;
      El : Iir;
      Lib : Iir_Library_Declaration;
      Lib_Mark, Ent_Mark, Sep_Mark, Unit_Mark : Id_Mark_Type;
      Id : Name_Id;
   begin
      Update_Node_Infos;

      Design_File := Get_Design_File (Unit);

      if False then
         El := Get_Context_Items (Unit);
         while El /= Null_Iir loop
            case Get_Kind (El) is
               when Iir_Kind_Use_Clause =>
                  null;
               when Iir_Kind_Library_Clause =>
                  null;
               when others =>
                  Error_Kind ("translate1", El);
            end case;
            El := Get_Chain (El);
         end loop;
      end if;

      El := Get_Library_Unit (Unit);
      if Flags.Verbose then
         Ada.Text_IO.Put ("translating ");
         if Main then
            Ada.Text_IO.Put ("(with code generation) ");
         end if;
         Ada.Text_IO.Put_Line (Disp_Node (El));
      end if;

      --  Create the prefix for identifiers.
      Lib := Get_Library (Get_Design_File (Unit));
      Reset_Identifier_Prefix;
      if Lib = Libraries.Work_Library then
         Id := Libraries.Work_Library_Name;
      else
         Id := Get_Identifier (Lib);
      end if;
      Push_Identifier_Prefix (Lib_Mark, Id);

      if Get_Kind (El) = Iir_Kind_Architecture_Body then
         --  Put 'ARCH' between the entity name and the architecture name, to
         --  avoid a name clash with names from entity (eg an entity port with
         --  the same name as an architecture).
         Push_Identifier_Prefix (Ent_Mark, Get_Identifier (Get_Entity (El)));
         Push_Identifier_Prefix (Sep_Mark, "ARCH");
      end if;
      Id := Get_Identifier (El);
      if Id /= Null_Identifier then
         Push_Identifier_Prefix (Unit_Mark, Id);
      end if;

      if Main then
         Set_Global_Storage (O_Storage_Public);
         --  Create the variable containing the current file name.
         Gen_Filename (Get_Design_File (Unit));
      else
         Set_Global_Storage (O_Storage_External);
      end if;

      New_Debug_Filename_Decl
        (Name_Table.Image (Get_Design_File_Filename (Design_File)));

      Current_Library_Unit := El;

      case Get_Kind (El) is
         when Iir_Kind_Package_Declaration =>
            New_Debug_Comment_Decl
              ("package declaration " & Image_Identifier (El));
            Chap2.Translate_Package_Declaration (El);
         when Iir_Kind_Package_Body =>
            New_Debug_Comment_Decl ("package body " & Image_Identifier (El));
            --Push_Global_Factory (O_Storage_Private);
            Chap2.Translate_Package_Body (El);
            --Pop_Global_Factory;
         when Iir_Kind_Entity_Declaration =>
            New_Debug_Comment_Decl ("entity " & Image_Identifier (El));
            --Set_Global_Storage (O_Storage_Private);
            Chap1.Translate_Entity_Declaration (El);
         when Iir_Kind_Architecture_Body =>
            New_Debug_Comment_Decl ("architecture " & Image_Identifier (El));
            --Set_Global_Storage (O_Storage_Private);
            Chap1.Translate_Architecture_Body (El);
         when Iir_Kind_Configuration_Declaration =>
            New_Debug_Comment_Decl ("configuration " & Image_Identifier (El));
            if Id = Null_Identifier then
               declare
                  Mark : Id_Mark_Type;
                  Mark_Entity : Id_Mark_Type;
                  Mark_Arch : Id_Mark_Type;
                  Mark_Sep : Id_Mark_Type;
                  Arch : Iir;
                  Entity : constant Iir := Get_Entity (El);
               begin
                  --  Note: this is done inside the architecture identifier.
                  Push_Identifier_Prefix
                    (Mark_Entity, Get_Identifier (Entity));
                  Arch := Get_Block_Specification
                    (Get_Block_Configuration (El));
                  Push_Identifier_Prefix (Mark_Sep, "ARCH");
                  Push_Identifier_Prefix (Mark_Arch, Get_Identifier (Arch));
                  Push_Identifier_Prefix
                    (Mark, Name_Table.Get_Identifier ("DEFAULT_CONFIG"));
                  Chap1.Translate_Configuration_Declaration (El);
                  Pop_Identifier_Prefix (Mark);
                  Pop_Identifier_Prefix (Mark_Arch);
                  Pop_Identifier_Prefix (Mark_Sep);
                  Pop_Identifier_Prefix (Mark_Entity);
               end;
            else
               Chap1.Translate_Configuration_Declaration (El);
            end if;
         when others =>
            Error_Kind ("translate", El);
      end case;

      Current_Filename_Node := O_Dnode_Null;
      Current_Library_Unit := Null_Iir;

      --Pop_Global_Factory;
      if Id /= Null_Identifier then
         Pop_Identifier_Prefix (Unit_Mark);
      end if;
      if Get_Kind (El) = Iir_Kind_Architecture_Body then
         Pop_Identifier_Prefix (Sep_Mark);
         Pop_Identifier_Prefix (Ent_Mark);
      end if;
      Pop_Identifier_Prefix (Lib_Mark);
   end Translate;

   procedure Initialize
   is
      Interfaces : O_Inter_List;
      Param : O_Dnode;
   begin
      --  Create the node extension for translate.
      Node_Infos.Init;
      Node_Infos.Set_Last (4);
      Node_Infos.Table (0 .. 4) := (others => null);

      --  Force to unnest subprograms is the code generator doesn't support
      --  nested subprograms.
      if not Ortho_Nodes.Has_Nested_Subprograms then
         Flag_Unnest_Subprograms := True;
      end if;

      New_Debug_Comment_Decl ("internal declarations, part 1");

      -- Create well known identifiers.
      Wki_This := Get_Identifier ("this");
      Wki_Size := Get_Identifier ("size");
      Wki_Res := Get_Identifier ("res");
      Wki_Dir_To := Get_Identifier ("dir_to");
      Wki_Dir_Downto := Get_Identifier ("dir_downto");
      Wki_Left := Get_Identifier ("left");
      Wki_Right := Get_Identifier ("right");
      Wki_Dir := Get_Identifier ("dir");
      Wki_Length := Get_Identifier ("length");
      Wki_I := Get_Identifier ("I");
      Wki_Instance := Get_Identifier ("INSTANCE");
      Wki_Arch_Instance := Get_Identifier ("ARCH_INSTANCE");
      Wki_Name := Get_Identifier ("NAME");
      Wki_Sig := Get_Identifier ("sig");
      Wki_Obj := Get_Identifier ("OBJ");
      Wki_Rti := Get_Identifier ("RTI");
      Wki_Parent := Get_Identifier ("parent");
      Wki_Filename := Get_Identifier ("filename");
      Wki_Line := Get_Identifier ("line");
      Wki_Lo := Get_Identifier ("lo");
      Wki_Hi := Get_Identifier ("hi");
      Wki_Mid := Get_Identifier ("mid");
      Wki_Cmp := Get_Identifier ("cmp");
      Wki_Upframe := Get_Identifier ("UPFRAME");
      Wki_Frame := Get_Identifier ("FRAME");

      Sizetype := New_Unsigned_Type (32);
      New_Type_Decl (Get_Identifier ("__ghdl_size_type"), Sizetype);

      --  Create __ghdl_index_type, which is the type for *all* array index.
      Ghdl_Index_Type := New_Unsigned_Type (32);
      New_Type_Decl (Get_Identifier ("__ghdl_index_type"), Ghdl_Index_Type);

      Ghdl_Index_0 := New_Unsigned_Literal (Ghdl_Index_Type, 0);
      Ghdl_Index_1 := New_Unsigned_Literal (Ghdl_Index_Type, 1);

      Ghdl_I32_Type := New_Signed_Type (32);
      New_Type_Decl (Get_Identifier ("__ghdl_i32"), Ghdl_I32_Type);

      Ghdl_Real_Type := New_Float_Type;
      New_Type_Decl (Get_Identifier ("__ghdl_real"), Ghdl_Real_Type);

      if not Flag_Only_32b then
         Ghdl_I64_Type := New_Signed_Type (64);
         New_Type_Decl (Get_Identifier ("__ghdl_i64"), Ghdl_I64_Type);
      end if;

      --  File index for elaborated file object.
      Ghdl_File_Index_Type := New_Unsigned_Type (32);
      New_Type_Decl (Get_Identifier ("__ghdl_file_index"),
                     Ghdl_File_Index_Type);
      Ghdl_File_Index_Ptr_Type := New_Access_Type (Ghdl_File_Index_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_file_index_ptr"),
                     Ghdl_File_Index_Ptr_Type);

      --  Create char, char [] and char *.
      Char_Type_Node := New_Unsigned_Type (8);
      New_Type_Decl (Get_Identifier ("__ghdl_char"), Char_Type_Node);

      Chararray_Type := New_Array_Type (Char_Type_Node, Ghdl_Index_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_chararray"), Chararray_Type);

      Char_Ptr_Type := New_Access_Type (Chararray_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_char_ptr"), Char_Ptr_Type);

      Char_Ptr_Array_Type := New_Array_Type (Char_Ptr_Type, Ghdl_Index_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_char_ptr_array"),
                     Char_Ptr_Array_Type);

      Char_Ptr_Array_Ptr_Type := New_Access_Type (Char_Ptr_Array_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_char_ptr_array_ptr"),
                     Char_Ptr_Array_Ptr_Type);

      --  Generic pointer.
      Ghdl_Ptr_Type := New_Access_Type (Char_Type_Node);
      New_Type_Decl (Get_Identifier ("__ghdl_ptr"), Ghdl_Ptr_Type);

      --  Create record
      --     len : natural;
      --     str : C_String;
      --  end record;
      declare
         Constr : O_Element_List;
      begin
         Start_Record_Type (Constr);
         New_Record_Field (Constr, Ghdl_Str_Len_Type_Len_Field,
                           Get_Identifier ("len"), Ghdl_Index_Type);
         New_Record_Field
           (Constr, Ghdl_Str_Len_Type_Str_Field,
            Get_Identifier ("str"), Char_Ptr_Type);
         Finish_Record_Type (Constr, Ghdl_Str_Len_Type_Node);
         New_Type_Decl (Get_Identifier ("__ghdl_str_len"),
                        Ghdl_Str_Len_Type_Node);
      end;

      Ghdl_Str_Len_Array_Type_Node := New_Array_Type
        (Ghdl_Str_Len_Type_Node, Ghdl_Index_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_str_len_array"),
                     Ghdl_Str_Len_Array_Type_Node);

      -- Create type __ghdl_str_len_ptr is access all __ghdl_str_len
      Ghdl_Str_Len_Ptr_Node := New_Access_Type (Ghdl_Str_Len_Type_Node);
      New_Type_Decl (Get_Identifier ("__ghdl_str_len_ptr"),
                     Ghdl_Str_Len_Ptr_Node);

      -- Create type __ghdl_bool_type is (false, true)
      New_Boolean_Type (Ghdl_Bool_Type,
                        Get_Identifier ("false"),
                        Ghdl_Bool_False_Node,
                        Get_Identifier ("true"),
                        Ghdl_Bool_True_Node);
      New_Type_Decl (Get_Identifier ("__ghdl_bool_type"),
                     Ghdl_Bool_Type);

      --  __ghdl_bool_array is array (ghdl_index_type) of ghdl_bool_type
      Ghdl_Bool_Array_Type :=
        New_Array_Type (Ghdl_Bool_Type, Ghdl_Index_Type);
      New_Type_Decl
        (Get_Identifier ("__ghdl_bool_array_type"), Ghdl_Bool_Array_Type);

      --  __ghdl_bool_array_ptr is access __ghdl_bool_array;
      Ghdl_Bool_Array_Ptr := New_Access_Type (Ghdl_Bool_Array_Type);
      New_Type_Decl
        (Get_Identifier ("__ghdl_bool_array_ptr"), Ghdl_Bool_Array_Ptr);

      --  Create type ghdl_compare_type is (lt, eq, ge);
      declare
         Constr : O_Enum_List;
      begin
         Start_Enum_Type  (Constr, 8);
         New_Enum_Literal (Constr, Get_Identifier ("lt"), Ghdl_Compare_Lt);
         New_Enum_Literal (Constr, Get_Identifier ("eq"), Ghdl_Compare_Eq);
         New_Enum_Literal (Constr, Get_Identifier ("gt"), Ghdl_Compare_Gt);
         Finish_Enum_Type (Constr, Ghdl_Compare_Type);
         New_Type_Decl (Get_Identifier ("__ghdl_compare_type"),
                        Ghdl_Compare_Type);
      end;

      --  Create:
      --  type __ghdl_location is record
      --     file : char_ptr_type;
      --     line : ghdl_i32;
      --     col : ghdl_i32;
      --  end record;
      declare
         Constr : O_Element_List;
      begin
         Start_Record_Type (Constr);
         New_Record_Field
           (Constr, Ghdl_Location_Filename_Node, Wki_Filename, Char_Ptr_Type);
         New_Record_Field
           (Constr, Ghdl_Location_Line_Node, Wki_Line, Ghdl_I32_Type);
         New_Record_Field (Constr, Ghdl_Location_Col_Node,
                           Get_Identifier ("col"),
                           Ghdl_I32_Type);
         Finish_Record_Type (Constr, Ghdl_Location_Type_Node);
         New_Type_Decl (Get_Identifier ("__ghdl_location"),
                        Ghdl_Location_Type_Node);
      end;
      -- Create type __ghdl_location_ptr is access __ghdl_location;
      Ghdl_Location_Ptr_Node := New_Access_Type (Ghdl_Location_Type_Node);
      New_Type_Decl (Get_Identifier ("__ghdl_location_ptr"),
                     Ghdl_Location_Ptr_Node);

      --  Create type ghdl_dir_type is (dir_to, dir_downto);
      declare
         Constr : O_Enum_List;
      begin
         Start_Enum_Type (Constr, 8);
         New_Enum_Literal (Constr, Wki_Dir_To, Ghdl_Dir_To_Node);
         New_Enum_Literal (Constr, Wki_Dir_Downto, Ghdl_Dir_Downto_Node);
         Finish_Enum_Type (Constr, Ghdl_Dir_Type_Node);
         New_Type_Decl (Get_Identifier ("__ghdl_dir_type"),
                        Ghdl_Dir_Type_Node);
      end;

      --  Create void* __ghdl_alloc (unsigned size);
      Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_alloc"),
                           O_Storage_External, Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Size, Sizetype);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Alloc_Ptr);

      --  procedure __ghdl_program_error (filename : char_ptr_type;
      --                                  line : ghdl_i32;
      --                                  code : ghdl_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_program_error"),
         O_Storage_External);
      New_Interface_Decl
        (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
      New_Interface_Decl
        (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("code"), Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Program_Error);

      --  procedure __ghdl_bound_check_failed_l1 (filename : char_ptr_type;
      --                                          line : ghdl_i32);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_bound_check_failed_l1"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Bound_Check_Failed_L1);

      --  Secondary stack subprograms.
      --  function __ghdl_stack2_allocate (size : ghdl_index_type)
      --    return ghdl_ptr_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_stack2_allocate"),
         O_Storage_External, Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Size, Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Stack2_Allocate);

      --  function __ghdl_stack2_mark return ghdl_ptr_type;
      Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_stack2_mark"),
                           O_Storage_External, Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Stack2_Mark);

      --  procedure __ghdl_stack2_release (mark : ghdl_ptr_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_stack2_release"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mark"),
                          Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Stack2_Release);

      --  procedure __ghdl_memcpy (dest : ghdl_ptr_type;
      --                           src  : ghdl_ptr_type;
      --                           length : ghdl_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_memcpy"), O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("dest"),
                          Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("src"),
                          Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Length, Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Memcpy);

      --  procedure __ghdl_deallocate (ptr : ghdl_ptr_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_deallocate"), O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Obj, Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Deallocate);

      -- function __ghdl_malloc (length : ghdl_index_type)
      --    return ghdl_ptr_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_malloc"), O_Storage_External,
         Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Length, Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Malloc);

      -- function __ghdl_malloc0 (length : ghdl_index_type)
      --    return ghdl_ptr_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_malloc0"), O_Storage_External,
         Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Length, Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Malloc0);

      --  function __ghdl_text_file_elaborate return file_index_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_text_file_elaborate"),
         O_Storage_External, Ghdl_File_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Elaborate);

      --  function __ghdl_file_elaborate (name : char_ptr_type)
      --                                 return file_index_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_file_elaborate"),
         O_Storage_External, Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Name, Char_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Elaborate);

      --  procedure __ghdl_file_finalize (file : file_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_file_finalize"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Finalize);

      --  procedure __ghdl_text_file_finalize (file : file_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_text_file_finalize"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Finalize);

      declare
         procedure Create_Protected_Subprg
           (Name : String; Subprg : out O_Dnode)
         is
         begin
            Start_Procedure_Decl
              (Interfaces, Get_Identifier (Name), O_Storage_External);
            New_Interface_Decl (Interfaces, Param, Wki_Obj, Ghdl_Ptr_Type);
            Finish_Subprogram_Decl (Interfaces, Subprg);
         end Create_Protected_Subprg;
      begin
         --  procedure __ghdl_protected_enter (obj : ghdl_ptr_type);
         Create_Protected_Subprg
           ("__ghdl_protected_enter", Ghdl_Protected_Enter);

         --  procedure __ghdl_protected_leave (obj : ghdl_ptr_type);
         Create_Protected_Subprg
           ("__ghdl_protected_leave", Ghdl_Protected_Leave);

         Create_Protected_Subprg
           ("__ghdl_protected_init", Ghdl_Protected_Init);

         Create_Protected_Subprg
           ("__ghdl_protected_fini", Ghdl_Protected_Fini);
      end;

      if Flag_Rti then
         Rtis.Rti_Initialize;
      end if;

      --  procedure __ghdl_signal_name_rti
      --       (obj : ghdl_rti_access;
      --        ctxt : ghdl_rti_access;
      --        addr : ghdl_ptr_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_name_rti"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Obj, Rtis.Ghdl_Rti_Access);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("ctxt"),
                          Rtis.Ghdl_Rti_Access);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("addr"),
                          Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Name_Rti);

      declare
         --  procedure NAME (this : ghdl_ptr_type;
         --                  proc : ghdl_ptr_type;
         --                  ctxt : ghdl_rti_access;
         --                  addr : ghdl_ptr_type);
         procedure Create_Process_Register (Name : String; Res : out O_Dnode)
         is
         begin
            Start_Procedure_Decl
              (Interfaces, Get_Identifier (Name), O_Storage_External);
            New_Interface_Decl
              (Interfaces, Param, Wki_This, Ghdl_Ptr_Type);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("proc"), Ghdl_Ptr_Type);
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("ctxt"),
                                Rtis.Ghdl_Rti_Access);
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("addr"),
                                Ghdl_Ptr_Type);
            Finish_Subprogram_Decl (Interfaces, Res);
         end Create_Process_Register;
      begin
         Create_Process_Register ("__ghdl_process_register",
                                  Ghdl_Process_Register);
         Create_Process_Register ("__ghdl_sensitized_process_register",
                                  Ghdl_Sensitized_Process_Register);
         Create_Process_Register ("__ghdl_postponed_process_register",
                                  Ghdl_Postponed_Process_Register);
         Create_Process_Register
           ("__ghdl_postponed_sensitized_process_register",
            Ghdl_Postponed_Sensitized_Process_Register);
      end;

      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_finalize_register"),
         O_Storage_External);
      New_Interface_Decl
        (Interfaces, Param, Wki_This, Ghdl_Ptr_Type);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("proc"), Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Finalize_Register);
   end Initialize;

   procedure Create_Signal_Subprograms
     (Suffix : String;
      Val_Type : O_Tnode;
      Create_Signal : out O_Dnode;
      Init_Signal : out O_Dnode;
      Simple_Assign : out O_Dnode;
      Start_Assign : out O_Dnode;
      Next_Assign : out O_Dnode;
      Associate_Value : out O_Dnode;
      Driving_Value : out O_Dnode)
   is
      Interfaces : O_Inter_List;
      Param : O_Dnode;
   begin
      --  function __ghdl_create_signal_XXX (init_val : VAL_TYPE)
      --                                     resolv_func : ghdl_ptr_type;
      --                                     resolv_inst : ghdl_ptr_type;
      --                                     return __ghdl_signal_ptr;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_create_signal_" & Suffix),
         O_Storage_External, Ghdl_Signal_Ptr);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("init_val"), Val_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("resolv_func"),
                          Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("resolv_inst"),
                          Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Create_Signal);

      --  procedure __ghdl_signal_init_XXX (sign : __ghdl_signal_ptr;
      --                                    val : VAL_TYPE);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_init_" & Suffix),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type);
      Finish_Subprogram_Decl (Interfaces, Init_Signal);

      --  procedure __ghdl_signal_simple_assign_XXX (sign : __ghdl_signal_ptr;
      --                                             val : VAL_TYPE);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_" & Suffix),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"), Val_Type);
      Finish_Subprogram_Decl (Interfaces, Simple_Assign);

      --  procedure __ghdl_signal_start_assign_XXX (sign : __ghdl_signal_ptr;
      --                                            reject : std_time;
      --                                            val : VAL_TYPE;
      --                                            after : std_time);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_" & Suffix),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
                          Std_Time_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
                          Val_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                          Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Start_Assign);

      --  procedure __ghdl_signal_next_assign_XXX (sign : __ghdl_signal_ptr;
      --                                            val : VAL_TYPE;
      --                                            after : std_time);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_" & Suffix),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
                          Val_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                          Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Next_Assign);

      --  procedure __ghdl_signal_associate_XXX (sign : __ghdl_signal_ptr;
      --                                        val : VAL_TYPE);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_associate_" & Suffix),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
                          Val_Type);
      Finish_Subprogram_Decl (Interfaces, Associate_Value);

      --  function __ghdl_signal_driving_value_XXX (sign : __ghdl_signal_ptr)
      --     return VAL_TYPE;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_driving_value_" & Suffix),
         O_Storage_External, Val_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Driving_Value);
   end Create_Signal_Subprograms;

   --  procedure __ghdl_image_NAME (res : std_string_ptr_node;
   --                               val : VAL_TYPE;
   --                               rti : ghdl_rti_access);
   --
   --  function __ghdl_value_NAME (val : std_string_ptr_node;
   --                              rti : ghdl_rti_access);
   --      return VAL_TYPE;
   procedure Create_Image_Value_Subprograms (Name : String;
                                             Val_Type : O_Tnode;
                                             Has_Td : Boolean;
                                             Image_Subprg : out O_Dnode;
                                             Value_Subprg : out O_Dnode)
   is
      Interfaces : O_Inter_List;
      Param : O_Dnode;
   begin
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_image_" & Name),
         O_Storage_External);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("res"), Std_String_Ptr_Node);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("val"), Val_Type);
      if Has_Td then
         New_Interface_Decl
           (Interfaces, Param, Get_Identifier ("rti"), Rtis.Ghdl_Rti_Access);
      end if;
      Finish_Subprogram_Decl (Interfaces, Image_Subprg);

      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_value_" & Name),
         O_Storage_External, Val_Type);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("val"), Std_String_Ptr_Node);
      if Has_Td then
         New_Interface_Decl
           (Interfaces, Param, Get_Identifier ("rti"), Rtis.Ghdl_Rti_Access);
      end if;
      Finish_Subprogram_Decl (Interfaces, Value_Subprg);
   end Create_Image_Value_Subprograms;

   --  Do internal declarations that need std.standard declarations.
   procedure Post_Initialize
   is
      Interfaces : O_Inter_List;
      Rec : O_Element_List;
      Param : O_Dnode;
      Integer_Otype : O_Tnode;
      Real_Otype : O_Tnode;
      Time_Otype : O_Tnode;
      Info : Type_Info_Acc;
   begin
      New_Debug_Comment_Decl ("internal declarations, part 2");
      Info := Get_Info (String_Type_Definition);
      Std_String_Node := Info.Ortho_Type (Mode_Value);
      Std_String_Ptr_Node := Info.Ortho_Ptr_Type (Mode_Value);
      Integer_Otype := Get_Ortho_Type (Integer_Type_Definition, Mode_Value);
      Real_Otype := Get_Ortho_Type (Real_Type_Definition, Mode_Value);
      Time_Otype := Get_Ortho_Type (Time_Type_Definition, Mode_Value);

      --  __ghdl_now : time;
      --  ??? maybe this should be a function ?
      New_Var_Decl (Ghdl_Now, Get_Identifier ("__ghdl_now"),
                    O_Storage_External, Time_Otype);

      --  procedure __ghdl_assert_failed (str : __ghdl_array_template;
      --                                  severity : ghdl_int);
      --                                  loc : __ghdl_location_acc;
      --                                  unit : ghdl_rti_access);

      --  procedure __ghdl_report (str : __ghdl_array_template;
      --                                  severity : ghdl_int);
      --                                  loc : __ghdl_location_acc;
      --                                  unit : ghdl_rti_access);
      declare
         procedure Create_Report_Subprg (Name : String; Subprg : out O_Dnode)
         is
         begin
            Start_Procedure_Decl
              (Interfaces, Get_Identifier (Name), O_Storage_External);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("msg"), Std_String_Ptr_Node);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("severity"),
               Get_Ortho_Type (Severity_Level_Type_Definition, Mode_Value));
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("location"),
                                Ghdl_Location_Ptr_Node);
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("unit"),
                                Rtis.Ghdl_Rti_Access);
            Finish_Subprogram_Decl (Interfaces, Subprg);
         end Create_Report_Subprg;
      begin
         Create_Report_Subprg ("__ghdl_assert_failed", Ghdl_Assert_Failed);
         Create_Report_Subprg ("__ghdl_psl_assert_failed",
                               Ghdl_Psl_Assert_Failed);
         Create_Report_Subprg ("__ghdl_psl_cover", Ghdl_Psl_Cover);
         Create_Report_Subprg ("__ghdl_psl_cover_failed",
                               Ghdl_Psl_Cover_Failed);
         Create_Report_Subprg ("__ghdl_report", Ghdl_Report);
      end;

      --  procedure __ghdl_text_write (file : __ghdl_file_index;
      --                               str  : std_string_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_text_write"), O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
                          Std_String_Ptr_Node);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_Write);

      --  function __ghdl_text_read_length (file : __ghdl_file_index;
      --                                    str : std_string_ptr)
      --     return std__standard_integer;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_text_read_length"),
         O_Storage_External, Integer_Otype);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
                          Std_String_Ptr_Node);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_Read_Length);

      --  procedure __ghdl_write_scalar (file : __ghdl_file_index;
      --                                 ptr : __ghdl_ptr_type;
      --                                 length : __ghdl_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_write_scalar"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("ptr"),
                          Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Length, Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Write_Scalar);

      --  procedure __ghdl_read_scalar (file : __ghdl_file_index;
      --                                ptr : __ghdl_ptr_type;
      --                                length : __ghdl_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_read_scalar"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("ptr"),
                          Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Length, Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Read_Scalar);

      --  function __ghdl_real_exp (left : std__standard__real;
      --                            right : std__standard__integer)
      --   return std__standard__real;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_real_exp"), O_Storage_External,
         Real_Otype);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("left"),
                          Real_Otype);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("right"),
                          Integer_Otype);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Real_Exp);

      --  function __ghdl_integer_exp (left : std__standard__integer;
      --                               right : std__standard__integer)
      --   return std__standard__integer;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_integer_exp"), O_Storage_External,
         Integer_Otype);
      New_Interface_Decl (Interfaces, Param, Wki_Left, Integer_Otype);
      New_Interface_Decl (Interfaces, Param, Wki_Right, Integer_Otype);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Integer_Exp);


      --  procedure __ghdl_image_b2 (res : std_string_ptr_node;
      --                             val : ghdl_bool_type;
      --                             rti : ghdl_rti_access);
      Create_Image_Value_Subprograms
        ("b2", Ghdl_Bool_Type, True, Ghdl_Image_B2, Ghdl_Value_B2);

      --  procedure __ghdl_image_e8 (res : std_string_ptr_node;
      --                             val : ghdl_i32_type;
      --                             rti : ghdl_rti_access);
      Create_Image_Value_Subprograms
        ("e8", Ghdl_I32_Type, True, Ghdl_Image_E8, Ghdl_Value_E8);

      --  procedure __ghdl_image_e32 (res : std_string_ptr_node;
      --                             val : ghdl_i32_type;
      --                             rti : ghdl_rti_access);
      Create_Image_Value_Subprograms
        ("e32", Ghdl_I32_Type, True, Ghdl_Image_E32, Ghdl_Value_E32);

      --  procedure __ghdl_image_i32 (res : std_string_ptr_node;
      --                              val : ghdl_i32_type);
      Create_Image_Value_Subprograms
        ("i32", Ghdl_I32_Type, False, Ghdl_Image_I32, Ghdl_Value_I32);

      --  procedure __ghdl_image_p32 (res : std_string_ptr_node;
      --                              val : ghdl_i32_type;
      --                             rti : ghdl_rti_access);
      Create_Image_Value_Subprograms
        ("p32", Ghdl_I32_Type, True, Ghdl_Image_P32, Ghdl_Value_P32);

      --  procedure __ghdl_image_p64 (res : std_string_ptr_node;
      --                              val : ghdl_i64_type;
      --                             rti : ghdl_rti_access);
      if not Flag_Only_32b then
         Create_Image_Value_Subprograms
           ("p64", Ghdl_I64_Type, True, Ghdl_Image_P64, Ghdl_Value_P64);
      end if;

      --  procedure __ghdl_image_f64 (res : std_string_ptr_node;
      --                              val : ghdl_real_type);
      Create_Image_Value_Subprograms
        ("f64", Ghdl_Real_Type, False, Ghdl_Image_F64, Ghdl_Value_F64);

      -------------
      --  files  --
      -------------

      --  procedure __ghdl_text_file_open (file : file_index_type;
      --                                   mode : Ghdl_I32_Type;
      --                                   str : std__standard__string_PTR);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_text_file_open"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
                          Ghdl_I32_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
                          Std_String_Ptr_Node);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Open);

      --  procedure __ghdl_file_open (file : file_index_type;
      --                              mode : Ghdl_I32_Type;
      --                              str : std__standard__string_PTR);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_file_open"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
                          Ghdl_I32_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
                          Std_String_Ptr_Node);
      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Open);

      --  function __ghdl_text_file_open_status
      --    (file : file_index_type;
      --     mode : Ghdl_I32_Type;
      --     str : std__standard__string_PTR)
      --     return ghdl_i32_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_text_file_open_status"),
         O_Storage_External, Ghdl_I32_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
                          Ghdl_I32_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
                          Std_String_Ptr_Node);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Open_Status);

      --  function __ghdl_file_open_status (file : file_index_type;
      --                                    mode : Ghdl_I32_Type;
      --                                    str : std__standard__string_PTR)
      --     return ghdl_i32_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_file_open_status"),
         O_Storage_External, Ghdl_I32_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("mode"),
                          Ghdl_I32_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("str"),
                          Std_String_Ptr_Node);
      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Open_Status);

      --  function __ghdl_file_endfile (file : file_index_type)
      --    return std_boolean_type_node;
      Start_Function_Decl (Interfaces, Get_Identifier ("__ghdl_file_endfile"),
                           O_Storage_External, Std_Boolean_Type_Node);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Endfile);

      --  procedure __ghdl_text_file_close (file : file_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_text_file_close"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Text_File_Close);

      --  procedure __ghdl_file_close (file : file_index_type);
      Start_Procedure_Decl (Interfaces, Get_Identifier ("__ghdl_file_close"),
                            O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("file"),
                          Ghdl_File_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_File_Close);

      ---------------
      --  signals  --
      ---------------

      --  procedure __ghdl_signal_create_resolution
      --    (func : ghdl_ptr_type;
      --     instance : ghdl_ptr_type;
      --     sig : ghdl_ptr_type;
      --     nbr_sig : ghdl_index_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_create_resolution"),
         O_Storage_External);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("func"), Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Instance, Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Ptr_Type);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("nbr_sig"), Ghdl_Index_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Create_Resolution);

      --  Declarations for signals.
      --  Max length of a scalar type.
      --  type __ghdl_scalar_bytes is __ghdl_chararray (0 .. 8);
      Ghdl_Scalar_Bytes := New_Constrained_Array_Type
        (Chararray_Type, New_Unsigned_Literal (Ghdl_Index_Type, 8));
      New_Type_Decl (Get_Identifier ("__ghdl_scalar_bytes"),
                     Ghdl_Scalar_Bytes);

      New_Uncomplete_Record_Type (Ghdl_Signal_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_signal"), Ghdl_Signal_Type);

      Ghdl_Signal_Ptr := New_Access_Type (Ghdl_Signal_Type);
      New_Type_Decl (Get_Identifier ("__ghdl_signal_ptr"), Ghdl_Signal_Ptr);

      --  Type __signal_signal is record
      Start_Uncomplete_Record_Type (Ghdl_Signal_Type, Rec);
      New_Record_Field (Rec, Ghdl_Signal_Value_Field,
                        Get_Identifier ("value"),
                        Ghdl_Scalar_Bytes);
      New_Record_Field (Rec, Ghdl_Signal_Driving_Value_Field,
                        Get_Identifier ("driving_value"),
                        Ghdl_Scalar_Bytes);
      New_Record_Field (Rec, Ghdl_Signal_Last_Value_Field,
                        Get_Identifier ("last_value"),
                        Ghdl_Scalar_Bytes);
      New_Record_Field (Rec, Ghdl_Signal_Last_Event_Field,
                        Get_Identifier ("last_event"),
                        Time_Otype);
      New_Record_Field (Rec, Ghdl_Signal_Last_Active_Field,
                        Get_Identifier ("last_active"),
                        Time_Otype);
      New_Record_Field (Rec, Ghdl_Signal_Event_Field,
                        Get_Identifier ("event"),
                        Std_Boolean_Type_Node);
      New_Record_Field (Rec, Ghdl_Signal_Active_Field,
                        Get_Identifier ("active"),
                        Std_Boolean_Type_Node);
      New_Record_Field (Rec, Ghdl_Signal_Has_Active_Field,
                        Get_Identifier ("has_active"),
                        Ghdl_Bool_Type);
      Finish_Record_Type (Rec, Ghdl_Signal_Type);

      Ghdl_Signal_Ptr_Ptr := New_Access_Type (Ghdl_Signal_Ptr);
      New_Type_Decl (Get_Identifier ("__ghdl_signal_ptr_ptr"),
                     Ghdl_Signal_Ptr_Ptr);

      --  procedure __ghdl_signal_merge_rti
      --       (sig : ghdl_signal_ptr; rti : ghdl_rti_access)
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_merge_rti"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Wki_Rti, Rtis.Ghdl_Rti_Access);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Merge_Rti);

      --  procedure __ghdl_signal_add_source (targ : __ghdl_signal_ptr;
      --                                      src : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_add_source"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("targ"),
                          Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("src"),
                          Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Add_Source);

      --  procedure __ghdl_signal_effective_value (targ : __ghdl_signal_ptr;
      --                                           src : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_effective_value"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("targ"),
                          Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("src"),
                          Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Effective_Value);

      --  procedure __ghdl_signal_set_disconnect (sig : __ghdl_signal_ptr;
      --                                          val : std_time);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_set_disconnect"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("time"), Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Set_Disconnect);

      --  procedure __ghdl_signal_disconnect (sig : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_disconnect"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Disconnect);

      --  function __ghdl_signal_get_nbr_drivers (sig : __ghdl_signal_ptr)
      --                                          return ghdl_index_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_get_nbr_drivers"),
         O_Storage_External, Ghdl_Index_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Get_Nbr_Drivers);

      --  function __ghdl_signal_get_nbr_sources (sig : __ghdl_signal_ptr)
      --                                          return ghdl_index_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_get_nbr_ports"),
         O_Storage_External, Ghdl_Index_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Get_Nbr_Ports);

      --  function __ghdl_signal_read_driver (sig : __ghdl_signal_ptr;
      --                                      num : ghdl_index_type)
      --                                     return ghdl_ptr_type;
      declare
         procedure Create_Signal_Read (Name : String; Subprg : out O_Dnode) is
         begin
            Start_Function_Decl
              (Interfaces, Get_Identifier (Name),
               O_Storage_External, Ghdl_Ptr_Type);
            New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("num"), Ghdl_Index_Type);
            Finish_Subprogram_Decl (Interfaces, Subprg);
         end Create_Signal_Read;
      begin
         Create_Signal_Read
           ("__ghdl_signal_read_driver", Ghdl_Signal_Read_Driver);
         Create_Signal_Read
           ("__ghdl_signal_read_port", Ghdl_Signal_Read_Port);
      end;

      --  function __ghdl_signal_driving (sig : __ghdl_signal_ptr)
      --                                 return std_boolean;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_driving"),
         O_Storage_External, Std_Boolean_Type_Node);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Driving);

      --  procedure __ghdl_signal_simple_assign_error
      --              (sig : __ghdl_signal_ptr;
      --               filename : char_ptr_type;
      --               line : ghdl_i32);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_simple_assign_error"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Simple_Assign_Error);

      --  procedure __ghdl_signal_start_assign_error (sign : __ghdl_signal_ptr;
      --                                              reject : std_time;
      --                                              after : std_time;
      --                                              filename : char_ptr_type;
      --                                              line : ghdl_i32);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_error"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
                          Std_Time_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                          Std_Time_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Error);

      --  procedure __ghdl_signal_next_assign_error (sig : __ghdl_signal_ptr;
      --                                             after : std_time;
      --                                             filename : char_ptr_type;
      --                                             line : ghdl_i32);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_error"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                          Std_Time_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Filename, Char_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Wki_Line, Ghdl_I32_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Error);

      --  procedure __ghdl_signal_start_assign_null (sig : __ghdl_signal_ptr;
      --                                             reject : std_time;
      --                                             after : std_time);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_start_assign_null"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("reject"),
                          Std_Time_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                          Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Start_Assign_Null);

      --  procedure __ghdl_signal_next_assign_null (sig : __ghdl_signal_ptr;
      --                                            after : std_time);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_next_assign_null"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("after"),
                          Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Next_Assign_Null);

      --  function __ghdl_create_signal_enum8 (init_val : ghdl_i32_type)
      --                                       return __ghdl_signal_ptr;
      --  procedure __ghdl_signal_simple_assign_e8 (sign : __ghdl_signal_ptr;
      --                                            val : __ghdl_integer);
      Create_Signal_Subprograms ("e8", Ghdl_I32_Type,
                                 Ghdl_Create_Signal_E8,
                                 Ghdl_Signal_Init_E8,
                                 Ghdl_Signal_Simple_Assign_E8,
                                 Ghdl_Signal_Start_Assign_E8,
                                 Ghdl_Signal_Next_Assign_E8,
                                 Ghdl_Signal_Associate_E8,
                                 Ghdl_Signal_Driving_Value_E8);

      --  function __ghdl_create_signal_enum8 (init_val : ghdl_i32_type)
      --                                       return __ghdl_signal_ptr;
      --  procedure __ghdl_signal_simple_assign_e8 (sign : __ghdl_signal_ptr;
      --                                            val : __ghdl_integer);
      Create_Signal_Subprograms ("e32", Ghdl_I32_Type,
                                 Ghdl_Create_Signal_E32,
                                 Ghdl_Signal_Init_E32,
                                 Ghdl_Signal_Simple_Assign_E32,
                                 Ghdl_Signal_Start_Assign_E32,
                                 Ghdl_Signal_Next_Assign_E32,
                                 Ghdl_Signal_Associate_E32,
                                 Ghdl_Signal_Driving_Value_E32);

      --  function __ghdl_create_signal_b2 (init_val : ghdl_bool_type)
      --                                    return __ghdl_signal_ptr;
      --  procedure __ghdl_signal_simple_assign_b2 (sign : __ghdl_signal_ptr;
      --                                            val : ghdl_bool_type);
      Create_Signal_Subprograms ("b2", Ghdl_Bool_Type,
                                 Ghdl_Create_Signal_B2,
                                 Ghdl_Signal_Init_B2,
                                 Ghdl_Signal_Simple_Assign_B2,
                                 Ghdl_Signal_Start_Assign_B2,
                                 Ghdl_Signal_Next_Assign_B2,
                                 Ghdl_Signal_Associate_B2,
                                 Ghdl_Signal_Driving_Value_B2);

      Create_Signal_Subprograms ("i32", Ghdl_I32_Type,
                                 Ghdl_Create_Signal_I32,
                                 Ghdl_Signal_Init_I32,
                                 Ghdl_Signal_Simple_Assign_I32,
                                 Ghdl_Signal_Start_Assign_I32,
                                 Ghdl_Signal_Next_Assign_I32,
                                 Ghdl_Signal_Associate_I32,
                                 Ghdl_Signal_Driving_Value_I32);

      Create_Signal_Subprograms ("f64", Ghdl_Real_Type,
                                 Ghdl_Create_Signal_F64,
                                 Ghdl_Signal_Init_F64,
                                 Ghdl_Signal_Simple_Assign_F64,
                                 Ghdl_Signal_Start_Assign_F64,
                                 Ghdl_Signal_Next_Assign_F64,
                                 Ghdl_Signal_Associate_F64,
                                 Ghdl_Signal_Driving_Value_F64);

      if not Flag_Only_32b then
         Create_Signal_Subprograms ("i64", Ghdl_I64_Type,
                                    Ghdl_Create_Signal_I64,
                                    Ghdl_Signal_Init_I64,
                                    Ghdl_Signal_Simple_Assign_I64,
                                    Ghdl_Signal_Start_Assign_I64,
                                    Ghdl_Signal_Next_Assign_I64,
                                    Ghdl_Signal_Associate_I64,
                                    Ghdl_Signal_Driving_Value_I64);
      end if;

      --  procedure __ghdl_process_add_sensitivity (sig : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_add_sensitivity"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Add_Sensitivity);

      --  procedure __ghdl_process_add_driver (sig : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_add_driver"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Add_Driver);

      --  procedure __ghdl_signal_add_direct_driver (sig : __ghdl_signal_ptr;
      --                                             Drv : Ghdl_Ptr_type);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_add_direct_driver"),
         O_Storage_External);
      New_Interface_Decl
        (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      New_Interface_Decl
        (Interfaces, Param, Get_Identifier ("drv"), Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Add_Direct_Driver);

      --  procedure __ghdl_signal_direct_assign (sig : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_direct_assign"),
         O_Storage_External);
      New_Interface_Decl
        (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Direct_Assign);

      declare
         procedure Create_Signal_Conversion (Name : String; Res : out O_Dnode)
         is
         begin
            Start_Procedure_Decl
              (Interfaces, Get_Identifier (Name), O_Storage_External);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("func"), Ghdl_Ptr_Type);
            New_Interface_Decl
              (Interfaces, Param, Wki_Instance, Ghdl_Ptr_Type);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("src"), Ghdl_Signal_Ptr);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("src_len"), Ghdl_Index_Type);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("dst"), Ghdl_Signal_Ptr);
            New_Interface_Decl
              (Interfaces, Param, Get_Identifier ("dst_len"), Ghdl_Index_Type);
            Finish_Subprogram_Decl (Interfaces, Res);
         end Create_Signal_Conversion;
      begin
         --  procedure __ghdl_signal_in_conversion (func : ghdl_ptr_type;
         --                                         instance : ghdl_ptr_type;
         --                                         src : ghdl_signal_ptr;
         --                                         src_len : ghdl_index_type;
         --                                         dst : ghdl_signal_ptr;
         --                                         dst_len : ghdl_index_type);
         Create_Signal_Conversion
           ("__ghdl_signal_in_conversion", Ghdl_Signal_In_Conversion);
         Create_Signal_Conversion
           ("__ghdl_signal_out_conversion", Ghdl_Signal_Out_Conversion);
      end;

      declare
         --  function __ghdl_create_XXX_signal (val : std_time)
         --    return __ghdl_signal_ptr;
         procedure Create_Signal_Attribute (Name : String; Res : out O_Dnode)
         is
         begin
            Start_Function_Decl (Interfaces, Get_Identifier (Name),
                                 O_Storage_External, Ghdl_Signal_Ptr);
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
                                Std_Time_Type);
            Finish_Subprogram_Decl (Interfaces, Res);
         end Create_Signal_Attribute;
      begin
         --  function __ghdl_create_stable_signal (val : std_time)
         --    return __ghdl_signal_ptr;
         Create_Signal_Attribute
           ("__ghdl_create_stable_signal", Ghdl_Create_Stable_Signal);

         --  function __ghdl_create_quiet_signal (val : std_time)
         --    return __ghdl_signal_ptr;
         Create_Signal_Attribute
           ("__ghdl_create_quiet_signal", Ghdl_Create_Quiet_Signal);

         --  function __ghdl_create_transaction_signal
         --    return __ghdl_signal_ptr;
         Start_Function_Decl
           (Interfaces, Get_Identifier ("__ghdl_create_transaction_signal"),
            O_Storage_External, Ghdl_Signal_Ptr);
         Finish_Subprogram_Decl (Interfaces, Ghdl_Create_Transaction_Signal);
      end;

      --  procedure __ghdl_signal_attribute_register_prefix
      --    (sig : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces,
         Get_Identifier ("__ghdl_signal_attribute_register_prefix"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl
        (Interfaces, Ghdl_Signal_Attribute_Register_Prefix);

      --  function __ghdl_create_delayed_signal (sig : __ghdl_signal_ptr;
      --                                         val : std_time)
      --    return __ghdl_signal_ptr;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_create_delayed_signal"),
         O_Storage_External, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("sig"),
                          Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("val"),
                          Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Create_Delayed_Signal);

      --  function __ghdl_signal_create_guard
      --    (this : ghdl_ptr_type;
      --     proc : ghdl_ptr_type;
      --     instance_name : __ghdl_instance_name_acc)
      --    return __ghdl_signal_ptr;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_create_guard"),
         O_Storage_External, Ghdl_Signal_Ptr);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("this"),
                          Ghdl_Ptr_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("proc"),
                          Ghdl_Ptr_Type);
--    New_Interface_Decl (Interfaces, Param, Get_Identifier ("instance_name"),
--                          Ghdl_Instance_Name_Acc);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Create_Guard);

      --  procedure __ghdl_signal_guard_dependence (sig : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_signal_guard_dependence"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Guard_Dependence);

      --  procedure __ghdl_process_wait_exit (void);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_wait_exit"),
         O_Storage_External);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Exit);

      --  void __ghdl_process_wait_timeout (time : std_time);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_wait_timeout"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"),
                          Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Timeout);

      --  void __ghdl_process_wait_set_timeout (time : std_time);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_wait_set_timeout"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("time"),
                          Std_Time_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Set_Timeout);

      --  void __ghdl_process_wait_add_sensitivity (sig : __ghdl_signal_ptr);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_wait_add_sensitivity"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Add_Sensitivity);

      --  function __ghdl_process_wait_suspend return __ghdl_bool_type;
      Start_Function_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_wait_suspend"),
         O_Storage_External, Ghdl_Bool_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Suspend);

      --  void __ghdl_process_wait_close (void);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_process_wait_close"),
         O_Storage_External);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Wait_Close);

      declare
         procedure Create_Get_Name (Name : String; Res : out O_Dnode)
         is
         begin
            Start_Procedure_Decl
              (Interfaces, Get_Identifier (Name), O_Storage_External);
            New_Interface_Decl
              (Interfaces, Param, Wki_Res, Std_String_Ptr_Node);
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("ctxt"),
                                Rtis.Ghdl_Rti_Access);
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("addr"),
                                Ghdl_Ptr_Type);
            New_Interface_Decl (Interfaces, Param, Get_Identifier ("name"),
                                Ghdl_Str_Len_Ptr_Node);
            Finish_Subprogram_Decl (Interfaces, Res);
         end Create_Get_Name;
      begin
         -- procedure __ghdl_get_path_name (res : std_string_ptr_node;
         --                                 ctxt : ghdl_rti_access;
         --                                 addr : ghdl_ptr_type;
         --                                 name : __ghdl_str_len_ptr);
         Create_Get_Name ("__ghdl_get_path_name", Ghdl_Get_Path_Name);

         -- procedure __ghdl_get_instance_name (res : std_string_ptr_node;
         --                                     ctxt : ghdl_rti_access;
         --                                     addr : ghdl_ptr_type;
         --                                     name : __ghdl_str_len_ptr);
         Create_Get_Name ("__ghdl_get_instance_name", Ghdl_Get_Instance_Name);
      end;

      --  procedure __ghdl_rti_add_package (rti : ghdl_rti_access)
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_rti_add_package"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Wki_Rti, Rtis.Ghdl_Rti_Access);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Rti_Add_Package);

      --  procedure __ghdl_rti_add_top (max_pkgs : ghdl_index_type;
      --                                pkgs : ghdl_rti_arr_acc);
      Start_Procedure_Decl
        (Interfaces, Get_Identifier ("__ghdl_rti_add_top"),
         O_Storage_External);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("max_pkgs"),
                          Ghdl_Index_Type);
      New_Interface_Decl (Interfaces, Param, Get_Identifier ("pkgs"),
                          Rtis.Ghdl_Rti_Arr_Acc);
      New_Interface_Decl (Interfaces, Param, Wki_Rti, Rtis.Ghdl_Rti_Access);
      New_Interface_Decl
        (Interfaces, Param, Wki_Instance, Ghdl_Ptr_Type);
      Finish_Subprogram_Decl (Interfaces, Ghdl_Rti_Add_Top);
   end Post_Initialize;

   procedure Translate_Std_Type_Declaration (Decl : Iir)
   is
      Chain : Iir;
      Infos : Chap7.Implicit_Subprogram_Infos;
   begin
      case Get_Kind (Decl) is
         when Iir_Kind_Type_Declaration =>
            Chap4.Translate_Type_Declaration (Decl);
         when Iir_Kind_Anonymous_Type_Declaration =>
            Chap4.Translate_Anonymous_Type_Declaration (Decl);
         when others =>
            Error_Kind ("translate_std_type_declaration", Decl);
      end case;

      --  Also declares the subprograms.
      Chain := Get_Chain (Decl);
      Chap7.Init_Implicit_Subprogram_Infos (Infos);
      while Chain /= Null_Iir loop
         case Get_Kind (Chain) is
            when Iir_Kind_Implicit_Function_Declaration
              | Iir_Kind_Implicit_Procedure_Declaration =>
               Chap7.Translate_Implicit_Subprogram (Chain, Infos);
               Chain := Get_Chain (Chain);
            when others =>
               exit;
         end case;
      end loop;
   end Translate_Std_Type_Declaration;

   procedure Translate_Standard (Main : Boolean)
   is
      Lib_Mark, Unit_Mark : Id_Mark_Type;
      Info : Ortho_Info_Acc;
      pragma Unreferenced (Info);
   begin
      Update_Node_Infos;

      New_Debug_Comment_Decl ("package std.standard");
      if Main then
         Gen_Filename (Std_Standard_File);
         Set_Global_Storage (O_Storage_Public);
      else
         Set_Global_Storage (O_Storage_External);
      end if;

      Info := Add_Info (Standard_Package, Kind_Package);

      Reset_Identifier_Prefix;
      Push_Identifier_Prefix
        (Lib_Mark, Get_Identifier (Libraries.Std_Library));
      Push_Identifier_Prefix
        (Unit_Mark, Get_Identifier (Standard_Package));

      Chap4.Translate_Bool_Type_Declaration (Boolean_Type_Declaration);
      --  We need this type very early, for predefined functions.
      Std_Boolean_Type_Node :=
        Get_Ortho_Type (Boolean_Type_Definition, Mode_Value);
      Std_Boolean_True_Node := Get_Ortho_Expr (Boolean_True);
      Std_Boolean_False_Node := Get_Ortho_Expr (Boolean_False);

      Std_Boolean_Array_Type :=
        New_Array_Type (Std_Boolean_Type_Node, Ghdl_Index_Type);
      New_Type_Decl (Create_Identifier ("BOOLEAN_ARRAY"),
                     Std_Boolean_Array_Type);
      Chap4.Translate_Bool_Type_Declaration (Bit_Type_Declaration);

      Chap4.Translate_Type_Declaration (Character_Type_Declaration);

      Chap4.Translate_Type_Declaration (Severity_Level_Type_Declaration);

      Chap4.Translate_Anonymous_Type_Declaration
        (Universal_Integer_Type_Declaration);
      Chap4.Translate_Subtype_Declaration
        (Universal_Integer_Subtype_Declaration);

      Chap4.Translate_Anonymous_Type_Declaration
        (Universal_Real_Type_Declaration);
      Chap4.Translate_Subtype_Declaration
        (Universal_Real_Subtype_Declaration);

      Chap4.Translate_Anonymous_Type_Declaration
        (Convertible_Integer_Type_Declaration);
      Chap4.Translate_Anonymous_Type_Declaration
        (Convertible_Real_Type_Declaration);

      Translate_Std_Type_Declaration (Real_Type_Declaration);
      Std_Real_Type_Node := Get_Ortho_Type (Real_Type_Definition, Mode_Value);
      Chap4.Translate_Subtype_Declaration (Real_Subtype_Declaration);

      Translate_Std_Type_Declaration (Integer_Type_Declaration);
      Std_Integer_Type_Node := Get_Ortho_Type
        (Integer_Type_Definition, Mode_Value);
      Chap4.Translate_Subtype_Declaration (Integer_Subtype_Declaration);
      Chap4.Translate_Subtype_Declaration (Natural_Subtype_Declaration);
      Chap4.Translate_Subtype_Declaration (Positive_Subtype_Declaration);

      Translate_Std_Type_Declaration (String_Type_Declaration);

      Translate_Std_Type_Declaration (Bit_Vector_Type_Declaration);

      declare
         Type_Staticness : Iir_Staticness;
         Subtype_Staticness : Iir_Staticness;
      begin
         --  With VHDL93 and later, time type is globally static.  As a result,
         --  it will be elaborated at run-time (and not statically).
         --  However, there is no elaboration of std.standard.  Furthermore,
         --  time type can be pre-elaborated without any difficulties.
         --  There is a kludge here:  set type staticess of time type locally
         --  and then revert it just after its translation.
         Type_Staticness := Get_Type_Staticness (Time_Type_Definition);
         Subtype_Staticness := Get_Type_Staticness (Time_Subtype_Definition);
         if Flags.Flag_Time_64 then
            Set_Type_Staticness (Time_Type_Definition, Locally);
         end if;
         Set_Type_Staticness (Time_Subtype_Definition, Locally);

         Translate_Std_Type_Declaration (Time_Type_Declaration);
         Chap4.Translate_Subtype_Declaration (Time_Subtype_Declaration);

         if Flags.Vhdl_Std > Vhdl_87 then
            Set_Type_Staticness (Delay_Length_Subtype_Definition, Locally);
            Chap4.Translate_Subtype_Declaration
              (Delay_Length_Subtype_Declaration);
            Set_Type_Staticness (Delay_Length_Subtype_Definition,
                                 Subtype_Staticness);
         end if;

         Set_Type_Staticness (Time_Type_Definition, Type_Staticness);
         Set_Type_Staticness (Time_Subtype_Definition, Subtype_Staticness);
      end;
      Std_Time_Type := Get_Ortho_Type (Time_Type_Definition, Mode_Value);

      if Flags.Vhdl_Std > Vhdl_87 then
         Translate_Std_Type_Declaration (File_Open_Kind_Type_Declaration);
         Translate_Std_Type_Declaration (File_Open_Status_Type_Declaration);
         Std_File_Open_Status_Type :=
           Get_Ortho_Type (File_Open_Status_Type_Definition, Mode_Value);
      end if;

      if Flag_Rti then
         Rtis.Generate_Unit (Standard_Package);
         Std_Standard_Boolean_Rti
           := Get_Info (Boolean_Type_Definition).Type_Rti;
         Std_Standard_Bit_Rti
           := Get_Info (Bit_Type_Definition).Type_Rti;
      end if;

      --  Std_Ulogic indexed array of STD.Boolean.
      --  Used by PSL to convert Std_Ulogic to boolean.
      Std_Ulogic_Boolean_Array_Type :=
        New_Constrained_Array_Type (Std_Boolean_Array_Type, New_Index_Lit (9));
      New_Type_Decl (Get_Identifier ("__ghdl_std_ulogic_boolean_array_type"),
                     Std_Ulogic_Boolean_Array_Type);
      New_Const_Decl (Ghdl_Std_Ulogic_To_Boolean_Array,
                      Get_Identifier ("__ghdl_std_ulogic_to_boolean_array"),
                      O_Storage_External, Std_Ulogic_Boolean_Array_Type);

      Pop_Identifier_Prefix (Unit_Mark);
      Pop_Identifier_Prefix (Lib_Mark);

      Post_Initialize;
      Current_Filename_Node := O_Dnode_Null;
      --Pop_Global_Factory;
   end Translate_Standard;

   procedure Finalize
   is
      Info : Ortho_Info_Acc;
      Prev_Info : Ortho_Info_Acc;
   begin
      Prev_Info := null;
      for I in Node_Infos.First .. Node_Infos.Last loop
         Info := Get_Info (I);
         if Info /= null and then Info /= Prev_Info then
            case Get_Kind (I) is
               when Iir_Kind_Constant_Declaration =>
                  if Get_Deferred_Declaration_Flag (I) = False
                    and then Get_Deferred_Declaration (I) /= Null_Iir
                  then
                     --  Info are copied from incomplete constant declaration
                     --  to full constant declaration.
                     Clear_Info (I);
                  else
                     Free_Info (I);
                  end if;
               when Iir_Kind_Record_Subtype_Definition
                 | Iir_Kind_Access_Subtype_Definition =>
                  null;
               when Iir_Kind_Enumeration_Type_Definition
                 | Iir_Kind_Array_Type_Definition
                 | Iir_Kind_Integer_Subtype_Definition
                 | Iir_Kind_Floating_Subtype_Definition
                 | Iir_Kind_Physical_Subtype_Definition
                 | Iir_Kind_Enumeration_Subtype_Definition =>
                  Free_Type_Info (Info, True);
               when Iir_Kind_Array_Subtype_Definition =>
                  if Get_Index_Constraint_Flag (I) then
                     Free_Var (Info.T.Array_Bounds);
                     Info.T := Ortho_Info_Type_Array_Init;
                     Free_Type_Info (Info, True);
                  end if;
               when others =>
                  --  By default, info are not shared.
                  --  The exception is infos for implicit subprograms, but
                  --  they are always consecutive and not free twice due to
                  --  prev_info mechanism.
                  Free_Info (I);
            end case;
            Prev_Info := Info;
         end if;
      end loop;
      Node_Infos.Free;
      Free_Old_Temp;
   end Finalize;

   package body Chap12 is
      --  Create __ghdl_ELABORATE
      procedure Gen_Main (Entity : Iir_Entity_Declaration;
                          Arch : Iir_Architecture_Body;
                          Config_Subprg : O_Dnode;
                          Nbr_Pkgs : Natural)
      is
         Entity_Info : Block_Info_Acc;
         Arch_Info : Block_Info_Acc;
         Inter_List : O_Inter_List;
         Assoc : O_Assoc_List;
         Instance : O_Dnode;
         Arch_Instance : O_Dnode;
         Mark : Id_Mark_Type;
         Arr_Type : O_Tnode;
         Arr : O_Dnode;
      begin
         Arch_Info := Get_Info (Arch);
         Entity_Info := Get_Info (Entity);

         --  We need to create code.
         Set_Global_Storage (O_Storage_Private);

         --  Create the array of RTIs for packages (as a variable, initialized
         --  during elaboration).
         Arr_Type := New_Constrained_Array_Type
           (Rtis.Ghdl_Rti_Array,
            New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Pkgs)));
         New_Var_Decl (Arr, Get_Identifier ("__ghdl_top_RTIARRAY"),
                       O_Storage_Private, Arr_Type);

         --  The elaboration entry point.
         Start_Procedure_Decl (Inter_List, Get_Identifier ("__ghdl_ELABORATE"),
                               O_Storage_Public);
         Finish_Subprogram_Decl (Inter_List, Ghdl_Elaborate);

         Start_Subprogram_Body (Ghdl_Elaborate);
         New_Var_Decl (Arch_Instance, Wki_Arch_Instance,
                       O_Storage_Local, Arch_Info.Block_Decls_Ptr_Type);

         New_Var_Decl (Instance, Wki_Instance, O_Storage_Local,
                       Entity_Info.Block_Decls_Ptr_Type);

         --  Create instance for the architecture.
         New_Assign_Stmt
           (New_Obj (Arch_Instance),
            Gen_Alloc (Alloc_System,
                       New_Lit (New_Sizeof (Arch_Info.Block_Decls_Type,
                                            Ghdl_Index_Type)),
                       Arch_Info.Block_Decls_Ptr_Type));

         --  Set the top instance.
         New_Assign_Stmt
           (New_Obj (Instance),
            New_Address (New_Selected_Acc_Value (New_Obj (Arch_Instance),
                                                 Arch_Info.Block_Parent_Field),
                         Entity_Info.Block_Decls_Ptr_Type));

         --  Clear parent field of entity link.
         New_Assign_Stmt
           (New_Selected_Element
            (New_Selected_Acc_Value (New_Obj (Instance),
                                     Entity_Info.Block_Link_Field),
             Rtis.Ghdl_Entity_Link_Parent),
            New_Lit (New_Null_Access (Rtis.Ghdl_Component_Link_Acc)));

         --  Set top instances and RTI.
         --  Do it before the elaboration code, since it may be used to
         --  diagnose errors.
         --  Call ghdl_rti_add_top
         Start_Association (Assoc, Ghdl_Rti_Add_Top);
         New_Association
           (Assoc, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
                                                  Unsigned_64 (Nbr_Pkgs))));
         New_Association
           (Assoc, New_Lit (New_Global_Address (Arr, Rtis.Ghdl_Rti_Arr_Acc)));
         New_Association
           (Assoc,
            New_Lit (Rtis.New_Rti_Address (Get_Info (Arch).Block_Rti_Const)));
         New_Association
           (Assoc, New_Convert_Ov (New_Obj_Value (Arch_Instance),
                                   Ghdl_Ptr_Type));
         New_Procedure_Call (Assoc);

         --  Add std.standard rti
         Start_Association (Assoc, Ghdl_Rti_Add_Package);
         New_Association
           (Assoc,
            New_Lit (Rtis.New_Rti_Address
                       (Get_Info (Standard_Package).Package_Rti_Const)));
         New_Procedure_Call (Assoc);

         Gen_Filename (Get_Design_File (Get_Design_Unit (Entity)));

         --  Elab package dependences of top entity (so that default
         --  expressions can be evaluated).
         Start_Association (Assoc, Entity_Info.Block_Elab_Pkg_Subprg);
         New_Procedure_Call (Assoc);

         --  init instance
         Push_Scope (Entity_Info.Block_Decls_Type, Instance);
         Push_Identifier_Prefix (Mark, "");
         Chap1.Translate_Entity_Init (Entity);

         --  elab instance
         Start_Association (Assoc, Arch_Info.Block_Elab_Subprg);
         New_Association (Assoc, New_Obj_Value (Instance));
         New_Procedure_Call (Assoc);

         --Chap6.Link_Instance_Name (Null_Iir, Entity);

         --  configure instance.
         Start_Association (Assoc, Config_Subprg);
         New_Association (Assoc, New_Obj_Value (Arch_Instance));
         New_Procedure_Call (Assoc);

         Pop_Identifier_Prefix (Mark);
         Pop_Scope (Entity_Info.Block_Decls_Type);
         Finish_Subprogram_Body;

         Current_Filename_Node := O_Dnode_Null;
      end Gen_Main;

      procedure Gen_Setup_Info
      is
         Cst : O_Dnode;
         pragma Unreferenced (Cst);
      begin
         Cst := Create_String (Flags.Flag_String,
                               Get_Identifier ("__ghdl_flag_string"),
                               O_Storage_Public);
      end Gen_Setup_Info;

      procedure Gen_Last_Arch (Entity : Iir_Entity_Declaration)
      is
         Entity_Info : Block_Info_Acc;

         Arch : Iir_Architecture_Body;
         Arch_Info : Block_Info_Acc;

         Lib : Iir_Library_Declaration;
         Lib_Mark, Entity_Mark, Arch_Mark : Id_Mark_Type;

         Config : Iir_Configuration_Declaration;
         Config_Info : Config_Info_Acc;

         Const : O_Dnode;
         Instance : O_Dnode;
         Inter_List : O_Inter_List;
         Constr : O_Assoc_List;
         Subprg : O_Dnode;
      begin
         Arch := Libraries.Get_Latest_Architecture (Entity);
         if Arch = Null_Iir then
            Error_Msg_Elab ("no architecture for " & Disp_Node (Entity));
         end if;
         Arch_Info := Get_Info (Arch);
         if Arch_Info = null then
            --  Nothing to do here, since the architecture is not used.
            return;
         end if;
         Entity_Info := Get_Info (Entity);

         --  Create trampoline for elab, default_architecture
         --  re-create instsize.
         Reset_Identifier_Prefix;
         Lib := Get_Library (Get_Design_File (Get_Design_Unit (Entity)));
         Push_Identifier_Prefix (Lib_Mark, Get_Identifier (Lib));
         Push_Identifier_Prefix (Entity_Mark, Get_Identifier (Entity));
         Push_Identifier_Prefix (Arch_Mark, "LASTARCH");

         --  Instance size.
         New_Const_Decl
           (Const, Create_Identifier ("INSTSIZE"), O_Storage_Public,
            Ghdl_Index_Type);
         Start_Const_Value (Const);
         Finish_Const_Value
           (Const, New_Sizeof (Arch_Info.Block_Decls_Type, Ghdl_Index_Type));

         --  Elaborator.
         Start_Procedure_Decl
           (Inter_List, Create_Identifier ("ELAB"), O_Storage_Public);
         New_Interface_Decl
           (Inter_List, Instance, Wki_Instance,
            Entity_Info.Block_Decls_Ptr_Type);
         Finish_Subprogram_Decl (Inter_List, Subprg);

         Start_Subprogram_Body (Subprg);
         Start_Association (Constr, Arch_Info.Block_Elab_Subprg);
         New_Association (Constr, New_Obj_Value (Instance));
         New_Procedure_Call (Constr);
         Finish_Subprogram_Body;

         --  Default config.
         Config := Get_Library_Unit
           (Get_Default_Configuration_Declaration (Arch));
         Config_Info := Get_Info (Config);
         if Config_Info /= null then
            --  Do not create a trampoline for the default_config if it is not
            --  used.
            Start_Procedure_Decl
              (Inter_List, Create_Identifier ("DEFAULT_CONFIG"),
               O_Storage_Public);
            New_Interface_Decl (Inter_List, Instance, Wki_Instance,
                                Arch_Info.Block_Decls_Ptr_Type);
            Finish_Subprogram_Decl (Inter_List, Subprg);

            Start_Subprogram_Body (Subprg);
            Start_Association (Constr, Config_Info.Config_Subprg);
            New_Association (Constr, New_Obj_Value (Instance));
            New_Procedure_Call (Constr);
            Finish_Subprogram_Body;
         end if;

         Pop_Identifier_Prefix (Arch_Mark);
         Pop_Identifier_Prefix (Entity_Mark);
         Pop_Identifier_Prefix (Lib_Mark);
      end Gen_Last_Arch;

      procedure Gen_Dummy_Default_Config (Arch : Iir_Architecture_Body)
      is
         Entity : Iir_Entity_Declaration;
         Lib : Iir_Library_Declaration;
         Lib_Mark, Entity_Mark, Sep_Mark, Arch_Mark : Id_Mark_Type;

         Inter_List : O_Inter_List;

         Subprg : O_Dnode;
      begin
         Reset_Identifier_Prefix;
         Entity := Get_Entity (Arch);
         Lib := Get_Library (Get_Design_File (Get_Design_Unit (Arch)));
         Push_Identifier_Prefix (Lib_Mark, Get_Identifier (Lib));
         Push_Identifier_Prefix (Entity_Mark, Get_Identifier (Entity));
         Push_Identifier_Prefix (Sep_Mark, "ARCH");
         Push_Identifier_Prefix (Arch_Mark, Get_Identifier (Arch));

         --  Elaborator.
         Start_Procedure_Decl
           (Inter_List, Create_Identifier ("DEFAULT_CONFIG"),
            O_Storage_Public);
         Finish_Subprogram_Decl (Inter_List, Subprg);

         Start_Subprogram_Body (Subprg);
         Chap6.Gen_Program_Error (Arch, Chap6.Prg_Err_Dummy_Config);
         Finish_Subprogram_Body;

         Pop_Identifier_Prefix (Arch_Mark);
         Pop_Identifier_Prefix (Sep_Mark);
         Pop_Identifier_Prefix (Entity_Mark);
         Pop_Identifier_Prefix (Lib_Mark);
      end Gen_Dummy_Default_Config;

      procedure Gen_Dummy_Package_Declaration (Unit : Iir_Design_Unit)
      is
         Pkg : Iir_Package_Declaration;
         Lib : Iir_Library_Declaration;
         Lib_Mark, Pkg_Mark : Id_Mark_Type;

         Decl : Iir;
      begin
         Libraries.Load_Design_Unit (Unit, Null_Iir);
         Pkg := Get_Library_Unit (Unit);
         Reset_Identifier_Prefix;
         Lib := Get_Library (Get_Design_File (Get_Design_Unit (Pkg)));
         Push_Identifier_Prefix (Lib_Mark, Get_Identifier (Lib));
         Push_Identifier_Prefix (Pkg_Mark, Get_Identifier (Pkg));

         if Get_Need_Body (Pkg) then
            Decl := Get_Declaration_Chain (Pkg);
            while Decl /= Null_Iir loop
               case Get_Kind (Decl) is
                  when Iir_Kind_Function_Declaration
                    | Iir_Kind_Procedure_Declaration =>
                     --  Generate empty body.

                     --  Never a second spec, as this is within a package
                     --  declaration.
                     pragma Assert
                       (not Is_Second_Subprogram_Specification (Decl));

                     if not Get_Foreign_Flag (Decl) then
                        declare
                           Mark : Id_Mark_Type;
                           Inter_List : O_Inter_List;
                           Proc : O_Dnode;
                        begin
                           Chap2.Push_Subprg_Identifier (Decl, Mark);
                           Start_Procedure_Decl
                             (Inter_List, Create_Identifier, O_Storage_Public);
                           Finish_Subprogram_Decl (Inter_List, Proc);
                           Start_Subprogram_Body (Proc);
                           Finish_Subprogram_Body;
                           Pop_Identifier_Prefix (Mark);
                        end;
                     end if;
                  when others =>
                     null;
               end case;
               Decl := Get_Chain (Decl);
            end loop;
         end if;

         --  Create the body elaborator.
         declare
            Inter_List : O_Inter_List;
            Proc : O_Dnode;
         begin
            Start_Procedure_Decl
              (Inter_List, Create_Identifier ("ELAB_BODY"), O_Storage_Public);
            Finish_Subprogram_Decl (Inter_List, Proc);
            Start_Subprogram_Body (Proc);
            Finish_Subprogram_Body;
         end;

         Pop_Identifier_Prefix (Pkg_Mark);
         Pop_Identifier_Prefix (Lib_Mark);
      end Gen_Dummy_Package_Declaration;

      procedure Write_File_List (Filelist : String)
      is
         use Interfaces.C_Streams;
         use System;
         use Configuration;
         use Name_Table;

         --  Add all dependences of UNIT.
         --  UNIT is not used, but added during link.
         procedure Add_Unit_Dependences (Unit : Iir_Design_Unit)
         is
            Dep_List : Iir_List;
            Dep : Iir;
            Dep_Unit : Iir_Design_Unit;
            Lib_Unit : Iir;
         begin
            --  Load the unit in memory to compute the dependence list.
            Libraries.Load_Design_Unit (Unit, Null_Iir);
            Update_Node_Infos;

            Set_Elab_Flag (Unit, True);
            Design_Units.Append (Unit);

            if Flag_Rti then
               Rtis.Generate_Library
                 (Get_Library (Get_Design_File (Unit)), True);
            end if;

            Lib_Unit := Get_Library_Unit (Unit);
            case Get_Kind (Lib_Unit) is
               when Iir_Kind_Package_Declaration =>
                  --  The body may be required due to incomplete constant
                  --  declarations, or to call to a subprogram.
                  declare
                     Pack_Body : Iir;
                  begin
                     Pack_Body := Libraries.Find_Secondary_Unit
                       (Unit, Null_Identifier);
                     if Pack_Body /= Null_Iir then
                        Add_Unit_Dependences (Pack_Body);
                     else
                        Gen_Dummy_Package_Declaration (Unit);
                     end if;
                  end;
               when Iir_Kind_Architecture_Body =>
                  Gen_Dummy_Default_Config (Lib_Unit);
               when others =>
                  null;
            end case;

            Dep_List := Get_Dependence_List (Unit);
            for I in Natural loop
               Dep := Get_Nth_Element (Dep_List, I);
               exit when Dep = Null_Iir;
               Dep_Unit := Libraries.Find_Design_Unit (Dep);
               if Dep_Unit = Null_Iir then
                  Error_Msg_Elab
                    ("could not find design unit " & Disp_Node (Dep));
               elsif not Get_Elab_Flag (Dep_Unit) then
                  Add_Unit_Dependences (Dep_Unit);
               end if;
            end loop;
         end Add_Unit_Dependences;

         --  Add not yet added units of FILE.
         procedure Add_File_Units (File : Iir_Design_File)
         is
            Unit : Iir_Design_Unit;
         begin
            Unit := Get_First_Design_Unit (File);
            while Unit /= Null_Iir loop
               if not Get_Elab_Flag (Unit) then
                  --  Unit not used.
                  Add_Unit_Dependences (Unit);
               end if;
               Unit := Get_Chain (Unit);
            end loop;
         end Add_File_Units;

         Nul : constant Character := Character'Val (0);
         Fname : String := Filelist & Nul;
         Mode : constant String := "wt" & Nul;
         F : FILEs;
         R : int;
         S : size_t;
         pragma Unreferenced (R, S); -- FIXME
         Id : Name_Id;
         Lib : Iir_Library_Declaration;
         File : Iir_Design_File;
         Unit : Iir_Design_Unit;
         J : Natural;
      begin
         F := fopen (Fname'Address, Mode'Address);
         if F = NULL_Stream then
            Error_Msg_Elab ("cannot open " & Filelist);
         end if;

         --  Set elab flags on units, and remove it on design files.
         for I in Design_Units.First .. Design_Units.Last loop
            Unit := Design_Units.Table (I);
            Set_Elab_Flag (Unit, True);
            File := Get_Design_File (Unit);
            Set_Elab_Flag (File, False);
         end loop;

         J := Design_Units.First;
         while J <= Design_Units.Last loop
            Unit := Design_Units.Table (J);
            File := Get_Design_File (Unit);
            if not Get_Elab_Flag (File) then
               Set_Elab_Flag (File, True);

               --  Add dependences of unused design units, otherwise the object
               --  link case failed.
               Add_File_Units (File);

               Lib := Get_Library (File);
               R := fputc (Character'Pos ('>'), F);
               Id := Get_Library_Directory (Lib);
               S := fwrite (Get_Address (Id),
                            size_t (Get_Name_Length (Id)), 1, F);
               R := fputc (10, F);

               Id := Get_Design_File_Filename (File);
               S := fwrite (Get_Address (Id),
                            size_t (Get_Name_Length (Id)), 1, F);
               R := fputc (10, F);
            end if;
            J := J + 1;
         end loop;
      end Write_File_List;

      procedure Elaborate
        (Primary : String;
         Secondary : String;
         Filelist : String;
         Whole : Boolean)
      is
         use Name_Table;
         use Configuration;

         Primary_Id : Name_Id;
         Secondary_Id : Name_Id;
         Unit : Iir_Design_Unit;
         Lib_Unit : Iir;
         Config : Iir_Design_Unit;
         Config_Lib : Iir_Configuration_Declaration;
         Entity : Iir_Entity_Declaration;
         Arch : Iir_Architecture_Body;
         Conf_Info : Config_Info_Acc;
         Last_Design_Unit : Natural;
         Nbr_Pkgs : Natural;
      begin
         Primary_Id := Get_Identifier (Primary);
         if Secondary /= "" then
            Secondary_Id := Get_Identifier (Secondary);
         else
            Secondary_Id := Null_Identifier;
         end if;
         Config := Configure (Primary_Id, Secondary_Id);
         if Config = Null_Iir then
            return;
         end if;
         Config_Lib := Get_Library_Unit (Config);
         Entity := Get_Entity (Config_Lib);
         Arch := Get_Block_Specification
           (Get_Block_Configuration (Config_Lib));

         --  Be sure the entity can be at the top of a design.
         Check_Entity_Declaration_Top (Entity);

         --  If all design units are loaded, late semantic checks can be
         --  performed.
         if Flag_Load_All_Design_Units then
            for I in Design_Units.First .. Design_Units.Last loop
               Unit := Design_Units.Table (I);
               Sem.Sem_Analysis_Checks_List (Unit, False);
               if Get_Analysis_Checks_List (Unit) /= Null_Iir_List then
                  --  There cannot be remaining checks to do.
                  raise Internal_Error;
               end if;
            end loop;
         end if;

         --  Return now in case of errors.
         if Nbr_Errors /= 0 then
            return;
         end if;

         if Flags.Verbose then
            Ada.Text_IO.Put_Line ("List of units in the hierarchy design:");
            for I in Design_Units.First .. Design_Units.Last loop
               Unit := Design_Units.Table (I);
               Lib_Unit := Get_Library_Unit (Unit);
               Ada.Text_IO.Put_Line (' ' & Disp_Node (Lib_Unit));
            end loop;
         end if;

         if Whole then
            --  In compile-and-elaborate mode, do not generate code for
            --  unused subprograms.
            --  FIXME: should be improved by creating a span-tree.
            Flag_Discard_Unused := True;
            Flag_Discard_Unused_Implicit := True;
         end if;

         --  Generate_Library add infos, therefore the info array must be
         --  adjusted.
         Update_Node_Infos;
         Rtis.Generate_Library (Libraries.Std_Library, True);
         Translate_Standard (Whole);

         --  Translate all configurations needed.
         --  Also, set the ELAB_FLAG on package with body.
         for I in Design_Units.First .. Design_Units.Last loop
            Unit := Design_Units.Table (I);
            Lib_Unit := Get_Library_Unit (Unit);

            if Whole then
               --  In whole compilation mode, force to generate RTIS of
               --  libraries.
               Rtis.Generate_Library
                 (Get_Library (Get_Design_File (Unit)), True);
            end if;

            case Get_Kind (Lib_Unit) is
               when Iir_Kind_Configuration_Declaration =>
                  --  Always generate code for configuration.
                  --  Because default binding may be changed between analysis
                  --  and elaboration.
                  Translate (Unit, True);
               when Iir_Kind_Entity_Declaration
                 | Iir_Kind_Architecture_Body
                 | Iir_Kind_Package_Declaration =>
                  Set_Elab_Flag (Unit, False);
                  Translate (Unit, Whole);
               when Iir_Kind_Package_Body =>
                  Set_Elab_Flag
                    (Get_Design_Unit (Get_Package (Lib_Unit)), True);
                  Translate (Unit, Whole);
               when others =>
                  Error_Kind ("elaborate", Lib_Unit);
            end case;
         end loop;

         --  Generate code to elaboration body-less package.
         --
         --  When a package is analyzed, we don't know wether there is body
         --  or not.  Therefore, we assume there is always a body, and will
         --  elaborate the body (which elaborates its spec).  If a package
         --  has no body, create the body elaboration procedure.
         for I in Design_Units.First .. Design_Units.Last loop
            Unit := Design_Units.Table (I);
            Lib_Unit := Get_Library_Unit (Unit);
            case Get_Kind (Lib_Unit) is
               when Iir_Kind_Package_Declaration =>
                  if not Get_Elab_Flag (Unit) then
                     Chap2.Elab_Package_Body (Lib_Unit, Null_Iir);
                  end if;
               when Iir_Kind_Entity_Declaration =>
                  Gen_Last_Arch (Lib_Unit);
               when Iir_Kind_Architecture_Body
                 | Iir_Kind_Package_Body
                 | Iir_Kind_Configuration_Declaration =>
                  null;
               when others =>
                  Error_Kind ("elaborate(2)", Lib_Unit);
            end case;
         end loop;

         Rtis.Generate_Top (Nbr_Pkgs);

         --  Create main code.
         Conf_Info := Get_Info (Config_Lib);
         Gen_Main (Entity, Arch, Conf_Info.Config_Subprg, Nbr_Pkgs);

         Gen_Setup_Info;

         --  Index of the last design unit, required by the design.
         Last_Design_Unit := Design_Units.Last;

         --  Disp list of files needed.
         --  FIXME: extract the link completion part of WRITE_FILE_LIST.
         if Filelist /= "" then
            Write_File_List (Filelist);
         end if;

         if Flags.Verbose then
            Ada.Text_IO.Put_Line ("List of units not used:");
            for I in Last_Design_Unit + 1 .. Design_Units.Last loop
               Unit := Design_Units.Table (I);
               Lib_Unit := Get_Library_Unit (Unit);
               Ada.Text_IO.Put_Line (' ' & Disp_Node (Lib_Unit));
            end loop;
         end if;
      end Elaborate;
   end Chap12;
end Translation;